Excel VBA質問箱 IV

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

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


805 / 13645 ツリー ←次へ | 前へ→

【78222】プリントスクリーンを貼り付ける方法 へいへい 16/5/29(日) 13:02 質問[未読]
【78223】Re:プリントスクリーンを貼り付ける方法 γ 16/5/29(日) 20:16 回答[未読]
【78224】Re:プリントスクリーンを貼り付ける方法 へいへい 16/5/29(日) 22:46 お礼[未読]

【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 "HTTPS:///・・・・・・・・"
    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

【78223】Re:プリントスクリーンを貼り付ける方法
回答  γ  - 16/5/29(日) 20:16 -

引用なし
パスワード
   '    Do While .Busy = True
'      DoEvents
'    Loop
に代えて
    
    Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE
       DoEvents
    Loop
    Sleep 1000
などとしてみては。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
も最初に追加してください。

【78224】Re:プリントスクリーンを貼り付ける方法
お礼  へいへい  - 16/5/29(日) 22:46 -

引用なし
パスワード
   白紙になることなくペーストできました。ありがとうございます。スリープを使えばよかったんですね。すばらしい

805 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free