サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2009/12/26 13:41
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[エクセル][ダイアログ][印刷関係] *
* キーワード：Excel,プリンタで印刷中,ダイアログ,現在 1 / 10 ページを印刷中です *
***********************************************************************************
タイトル ： VB→エクセルでプリント時の一瞬見えるダイアログ
記 事 No ： 13577
投 稿 日 ： 2009/04/07(Tue) 19:14
元質問者 ： たま
プリンタで印刷中に一瞬見える『印刷中 XXXXXXXX』<---（一瞬過ぎて内容が分かりません）
の様なダイアログが印刷部数分見えては消えするのですが、これを非表示にする方法は
無いでしょうか？
-----------------------------------------------------------------------------------
記事No ： 13579
投稿日 ： 2009/04/08(Wed) 06:26
回答者 ： 花ちゃん
-----------------------------------------------------------------------------------
Excel ではできなかったような？、Word ではできますが。
他の画面を最前面に表示する等したら、後ろに隠れるという事はありませんか？
試してはいませんが、下記のような方法も
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1114718426
一寸無責任だったので試してみました。
(動作確認用のコードに付きエラーチェック等は行っておりません。実装時、適時追加願います)
ダイアログが表示される画面中央にフォームを最前面に表示して[印刷中]のダイアログを
見えなくする方法。(必要に応じて表示位置を元に戻して下さい)
(一応問題なく、ダイアログが裏に隠れたままで印刷できます。）
Option Explicit
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = (-1)
Private Const SWP_NOSIZE = &H1&
Private Const SWP_NOMOVE = &H2&
Private Sub Command1_Click()
'----------------------------------------------------------------------
'ダイアログが表示される画面中央にフォームを表示する
'フォームを画面の中央に表示
Dim ScHe As Integer
Dim ScWi As Integer
ScHe = Screen.Height
ScWi = Screen.Width
Form1.Move (ScWi \ 2) - (Form1.Width \ 2), (ScHe \ 2) - (Form1.Height \ 2)
現在の位置とサイズで最前面に表示する
Call SetWindowPos(Me.hwnd, HWND_TOPMOST _
, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
'----------------------------------------------------------------------
'Excel の印刷処理部分
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("c:\vb2008.xls")
Set xlSheet = xlBook.Worksheets(1)
xlApp.DisplayAlerts = False
xlApp.Visible = False
xlSheet.PrintOut
Set xlSheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "処理が修了しました。"
End Sub
◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇
上記の方法ではだめだというなら、お勧めはできませんが下記でも非表示で印刷できます。
(但し、関数の実行中は、他の描画も抑制されたりする可能性があり場合によってはトラブルが
発生するような事があるかも知れませんのでご注意下さい)
Win32 API 関数で再描画を抑制する方法
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Const WM_SETREDRAW = &HB
Private Sub Command2_Click()
'Excel の印刷処理部分
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("c:\vb2008.xls")
Set xlSheet = xlBook.Worksheets(1)
xlApp.DisplayAlerts = False
xlApp.Visible = False
'---------------------------------------------------------------
Dim hwnd As Long
'デスクトップのハンドル
hwnd = xlApp.hwnd ' GetDesktopWindow()
Dim Ret As Long
'ウインドウの再描画を禁止する
Ret = SendMessage(hwnd, WM_SETREDRAW, 0&, 0&)
Ret = UpdateWindow(hwnd)
xlSheet.PrintOut
'ウインドウの再描画を許可する
Ret = SendMessage(hwnd, WM_SETREDRAW, 1&, 0&)
'---------------------------------------------------------------
Set xlSheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "処理が修了しました。"
End Sub
因みに、Word の場合は、下記で紹介しております。
http://hanatyan.sakura.ne.jp/patio/read.cgi?no=108
 |
