Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4138 / 76734

←次へ　｜　前へ→


	【78222】プリントスクリーンを貼り付ける方法

へいへい - 16/5/29(日) 13:02 -


	引用なし

	パスワード

ご教授お願いします。

ホームページをプリントスクリーンでコピーして、エクセルに張り付けるようにしたいのですが、以下では綺麗にコピーできる時と、白紙でコピーされる場合（おそらくコピーする段階で画面が開ききっていないことが原因）があり、使いものになりません。どうすれば、良いでしょうか？例えば、ホームページを立ち上げが完了したらコピー動作に移るようにしたいのですが。

Option Explicit
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
　 bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Declare Function GetVersionExA Lib "kernel32" _
　　　(lpVersionInformation As OSVERSIONINFO) As Integer
Public Type OSVERSIONINFO
　　dwOSVersionInfoSize As Long
　　dwMajorVersion As Long
　　dwMinorVersion As Long
　　dwBuildNumber As Long
　　dwPlatformId As Long
　　szCSDVersion As String * 128
End Type
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_SNAPSHOT = &H2C
Public Const VK_MENU = &H12
'==============================================================
Sub test()

　　Dim blnAboveVer4 As Boolean
　　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
　　With CreateObject("InternetExplorer.Application")
　　

　　　 .Visible = True
　　　 .Navigate "ＨＴＴＰＳ:///・・・・・・・・"
　　　　Do While .busy = True
　　　　 DoEvents
　　　　 Loop
　　　 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
　　　 .Quit
　　　 End With
　　With ActiveSheet
　　　 Range("A1").Activate
　　　 .Paste
　　　 End With
End Sub

4 hits

▼

【78222】プリントスクリーンを貼り付ける方法 へいへい 16/5/29(日) 13:02