| |
こんばんは。
試してみました。両方印刷は可能でしたよ！！
まず、ハードコピーで印刷する方法
新規ブックにて、ユーザーフォーム（UserForm1）を作成してください。
このUserForm1には、
ウェーブブラウザーコントロール（WebBrowser1）一つと
（サイト表示用）
コマンドボタン（CommandButton1）を配置してください
（印刷用）
標準モジュールに
'===========================================================
Sub main()
UserForm1.Show
End Sub
UserForm1のモジュールには
'============================================================
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private blnAboveVer4 As Boolean
Const KEYEVENTF_KEYUP = &H2
Const VK_SNAPSHOT = &H2C
Const VK_MENU = &H12
'============================================================
Private Sub CommandButton1_Click()
If blnAboveVer4 Then
keybd_event VK_SNAPSHOT, 1, 0, 0
Else
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End If
DoEvents
With Workbooks.Add
With .Worksheets(1)
.Range("a1").Select
.Paste
.PrintOut
End With
.Close False
End With
End Sub
'============================================================
Private Sub UserForm_Initialize()
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True
WebBrowser1.Navigate "ＨＴＴＰ://www.google.co.jp/"
' 半角ｈｔｔｐに直して実行すること
End Sub
これでmainを実行してください。
ユーザーフォームにホームページが表示されたら（上記コード例ではGoogle）、
ボタンをクリックしてください。
UserForm1の内容を印刷します。
ユーザフォームの大きさによっては、ページを跨いで印刷されるかもしれませんが、
1ページに納めて印刷したい場合は、ページ設定を操作してください。
|
|
ichinose
- 08/2/7(木) 21:22 -
