Web画面をプリントする方法（エクセルVBA）

エクセル2000です。
VBAでNavigateを使いWeb画面（イントラネット）を開き、
.Document.all.Item("Hoge****No").Value = Target.Text のような方法で入力を行い、
.Document.forms(0).submit で送信ボタンクリックして新たな画面を開くところまではできております。

次に、その開いた画面をプリントしたいのです。
どのようなコードになるのでしょうか？
ご教示いただければ幸いです。
(o。_。)oペコッ

現在のコードは以下のとおりです。
Dim objIE As Object

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub '複数セル不可
If Target.Column <> 1 Then Exit Sub 'A列のみ対象

'IEが起動しているかチェック。objIE.Nameプロパティの取得に成功したら起動とみなす。
Dim tmp As String
On Error Resume Next
tmp = objIE.Name
If Err.Number <> 0 Then
'エラーならIEが起動していないので、起動する
Set objIE = CreateObject("InternetExplorer.Application")
End If
On Error GoTo 0

With objIE
.Navigate "​http://******.co.jp/******/**/***/Details/Detail …​
.Visible = True
Do While .Busy = True
DoEvents
Loop
.Document.all.Item("Hoge****No").Value = Target.Text 'テストボックスへ入力：Name属性で指定
'オートコンプリートなどの機能が働く場合があるので、念のため待機
Do While .Busy = True
DoEvents
Loop
.Document.forms(0).submit '送信ボタンクリック
End With
End Sub

No.1 回答者： end-u 回答日時： 2009/11/17 19:18

定番の有益サイトです。

『.ExecWB メソッドを使い、 印刷処理を実行してみた。』
http://ken3-info.blog.ocn.ne.jp/objie/2009/06/ex …

簡易なサンプル。
Sub test()
　　Const READYSTATE_COMPLETE = 4
　　Const OLECMDID_PRINTPREVIEW = 7
　　Const OLECMDEXECOPT_DODEFAULT = 0

　　With CreateObject("internetExplorer.application")
　　　　.Visible = True
　　　　.navigate "http://oshiete1.goo.ne.jp/qa5455536.html"
　　　　While .busy Or (.readyState <> READYSTATE_COMPLETE)
　　　　　　DoEvents
　　　　Wend
　　　　.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
　　End With
End Sub

この回答への補足

追加の質問で申し訳ありません。

Printは出来ましたがPrintPreviewがうまくいきません。

Const OLECMDID_PRINTPREVIEW = 7
Const OLECMDEXECOPT_DODEFAULT = 0　として

.ExecWB OLECMDID_PRINTPREVIEW, , OLECMDEXECOPT_DODEFAULT

でやってみましたが最初のプレビュー画面を手動で閉じるとそれから先に行ってくれません。
プリントなら次々に印刷されていくのですが・・・・。

。

補足日時：2009/11/18 18:17

この回答へのお礼

ありがとうございます。
あまり理解できていませんが以下のようにやったところうまくエクセルデータを入力して表示させた画面を次々とプリントすることができました。
助かりました。

Sub 印刷TEST()
Const OLECMDID_PRINT = 6
Const OLECMDEXECOPT_DONTPROMPTUSER = 2
'IEが起動しているかチェック。objIE.Nameプロパティの取得に成功したら起動とみなす。
Dim tmp As String
On Error Resume Next
tmp = objIE.Name
If Err.Number <> 0 Then 'エラーならIEが起動していないので、起動する
Set objIE = CreateObject("InternetExplorer.Application")
End If
On Error GoTo 0

Set myRng = Selection
For Each c In myRng
If c <> "" Then
With objIE
.navigate "http://******.co.jp/******/**/***/Details/Detail …
.Visible = True
Do While .busy
DoEvents
Loop
.document.all.Item("HogehopgNo").Value = c.Text
Do While .busy
DoEvents
Loop
.document.forms(0).submit '送信ボタンクリック
Do While .busy
DoEvents
Loop
.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER '印刷
End With
End If
Next c
End Sub

お礼日時：2009/11/18 18:03

No.2 回答者： end-u 回答日時： 2009/11/18 23:01

>Printは出来ましたがPrintPreviewがうまくいきません。

ぅーん......
PrintPreviewは難しそうです...

ExecWBは非同期実行されますから、
>For Each c In myRng
な使い方だと、プレビュー画面が表示されたまま次の.navigateが実行されてしまいエラーです。
ExecWBを同期実行させるやり方ってあるんでしょうか...
そこは私にはわかりません。

私が思いつくのは、ExecWBメソッドの後、プレビュー画面のウィンドウハンドルを取得するまで待って、
それからさらにプレビュー画面ウィンドウが閉じるまで待つ、という方法くらいです。
WindowsAPI関数を使う事になるかと思いますが、そこまでして、その機能を実装しますか？
WinAPIも詳しいわけではないので触りしか書きませんが、考え方としては

.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
While hWnd = 0
　　Sleep 500
　　DoEvents
　　hWnd = FindWindow("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
Wend
While hWnd <> 0
　　Sleep 500
　　DoEvents
　　hWnd = FindWindow("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
Wend

こんな感じでいけるはず。
不安なので詳しい方からのレスもお待ちください。



ですが、そもそもプレビューは印刷設定の確認の為でしょうか？
その場合、Each c で設定せずに、最初の１回だけ確認すれば良かったりしませんか？
そのようにLoopを組む事で対応できないですかね？
最初の c だけプレビューしてユーザーに選択させ、OKであれば印刷し、
２個目の c からは印刷だけ...など。
考え方を変えて、時には妥協も必要かと。

MsgBoxはプレビュー画面に隠れてしまいますから、最前面に表示させるようにちょっと工夫が要ります。
WScriptのPopupメソッドを使ったりすると良いでしょう。
If CreateObject("WScript.Shell") _
　　.Popup("印刷設定はこれでいいですか？", , , vbYesNo + vbSystemModal) = vbYes Then
Else
End If

いずれにしても、これ以上の追加アドバイスはできそうもないので
ご自分で色々と調べて工夫してみてください。

この回答へのお礼

end-uさま、いつもありがとうございました。
プレビューしようと思ったのは一旦WEB画面を見て印刷の要否を判断するようにできたらと思ったのです。

それならば、なにもFor Each c ループせずに、最初に質問欄で書いたPrivate Sub Worksheet_SelectionChangeのイベントで一データずつやれば多少は不便ですが何とかなりそうです。
勝手を申しました。

お礼日時：2009/11/19 14:19

No.3 ベストアンサー 回答者： end-u 回答日時： 2009/11/23 23:26

追加レスつかなかったですね。

『多少は不便』という事なので、一応テストコードだけ全文載せておきます。
URLを入力したセル範囲を選択して実行です。
（[winXP/2000|2003/ie7][vista/2000|2007/ie8]の環境でテスト）

'標準モジュール
Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" ( _
　　　　　　　　　　　　　ByVal dwMillsecounds As Long)

Private Declare Function FindWindowA Lib "user32.dll" ( _
　　　　　　　　　　　　　　　　　　 ByVal cnm As String, _
　　　　　　　　　　　　　　　　　　 ByVal cap As String) As Long

Sub test()
　　Const READYSTATE_COMPLETE = 4
　　Const OLECMDID_PRINTPREVIEW = 7
　　Const OLECMDEXECOPT_DODEFAULT = 0
　　Dim r　　As Range
　　Dim hWnd As Long
　　
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　With CreateObject("internetExplorer.application")
　　　　.Visible = True
　　　　For Each r In Selection
　　　　　　.navigate r.Value
　　　　　　While .busy Or (.readyState <> READYSTATE_COMPLETE)
　　　　　　　　DoEvents
　　　　　　Wend
　　　　　　.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
　　　　　　While hWnd = 0
　　　　　　　　Sleep 500
　　　　　　　　DoEvents
　　　　　　　　hWnd = FindWindowA("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
　　　　　　Wend
　　　　　　While hWnd <> 0
　　　　　　　　Sleep 500
　　　　　　　　DoEvents
　　　　　　　　hWnd = FindWindowA("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
　　　　　　Wend
　　　　Next
　　End With
End Sub

この回答へのお礼

何度もありがとうございます。
しかも勤労感謝の日の夜にまで・・・・。
本当に感謝いたします。

以下のようにやったところうまくいきました！

Sub PreviewTEST()
Const READYSTATE_COMPLETE = 4
Const OLECMDID_PRINTPREVIEW = 7
Const OLECMDEXECOPT_DODEFAULT = 0
Dim myRng As Range, c As Range
Dim hWnd As Long
Dim tmp As String

On Error Resume Next
tmp = objIE.Name
If Err.Number <> 0 Then 'エラーならIEが起動していないので、起動する
Set objIE = CreateObject("InternetExplorer.Application")
End If
On Error GoTo 0
Set myRng = Selection
For Each c In myRng
If c <> "" Then
With objIE
navigate "​http://******.co.jp/******/**/***/Details/Detail …​
.Visible = True
Do While .busy
DoEvents
Loop
.document.all.Item("HogeHogeNo").Value = c.Text 'テストボックスへ入力：Name属性で指定
Do While .busy ' = True 'オートコンプリートなどの機能が働く場合があるので、念のため待機
DoEvents
Loop
.document.forms(0).submit '送信ボタンクリック
Do While .busy
DoEvents
Loop
.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
Do While hWnd = 0
DoEvents
hWnd = FindWindowA("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
Loop
Do While hWnd <> 0
DoEvents
hWnd = FindWindowA("Internet Explorer_TridentDlgFrame", "印刷プレビュー")
Loop
End With
End If
Next c
End Sub

ありがとうございました。

お礼日時：2009/11/24 11:19