#1.出展元はこちら
■t-hom’s diary
VBA スクリーンショットを撮るたびに自動でシートに張り付けるマクロ
規約読みました。
流用させて頂いております。ありがとうございます。
#2.クリップボードに入ったスクリーンショットを自動でExcelに張り付けていくマクロ
Declare Function OpenClipboard Lib "user32" (Optional ByVal hwnd As Long = 0) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Public LOCALOFFSET As Long
Sub AutoCapture()
'クリップボードを空にする。
OpenClipboard
EmptyClipboard
CloseClipboard
MsgBox "AutoCaptureを開始します。" & vbNewLine & _
"①貼り付け開始位置にカーソルを置いて" & vbCr & _
"②貼り付け開始位置変える場合はリセットボタン押して" & vbCr & _
"③このマクロ起動中はエビデンスに全て貼付けられるから注意", vbInformation
Dim CB As Variant
Dim IsFirst As Boolean: IsFirst = True
Do While True
CB = Application.ClipboardFormats
If StrConv(ActiveSheet.Cells(1, 1).Value, vbUpperCase) = "EXIT" Then GoTo Quit
If CB(1) <> -1 Then
For i = 1 To UBound(CB)
If CB(i) = xlClipboardFormatBitmap Then
If IsFirst = True Then
ActiveSheet.Paste Destination:=ActiveCell
IsFirst = False
LOCALOFFSET = LOCALOFFSET + CInt(Sheets("メニュー").Range("kankaku").Value)
Else
ActiveSheet.Paste Destination:=ActiveCell.Offset(LOCALOFFSET, 0)
LOCALOFFSET = LOCALOFFSET + CInt(Sheets("メニュー").Range("kankaku").Value)
End If
'クリップボードを空にする。
OpenClipboard
EmptyClipboard
CloseClipboard
End If
Next i
End If
DoEvents
Loop
Quit:
MsgBox "AutoCaptureを停止しました。", vbInformation
ActiveSheet.Cells(1, 1).ClearContents
End Sub
'貼付け位置をリセット
Sub reset()
LOCALOFFSET = 0
MsgBox "リセットしたよ"
End Sub
'マクロを停止する
Sub stopMacro()
MsgBox "マクロを停止したよ"
End
End Sub
#3.使用準備
①Alt+F11でVBEを開きシートでも標準モジュールでもいい標準モジュールに上記マクロを貼り付ける※Option Explicitの宣言がある場合は宣言を削除する
②シート名を「メニュー」とし、そこに以下キャプチャの様な感じでボタンを作成。マクロとボタンを関連付ける
・「開始」ボタンに「AutoCapture()」を登録する
・「停止」ボタンに「stopMacro()」を登録する
・「リセット」ボタンに「reset()」を登録する
③どこでもいいのでセルに「kankaku」という名前を付ける
#4.あとは使うだけ!
①マクロを開始し、スクリーンショットでキャプチャを取るとセルのカーソルが置いてある場所に張り付けられる。※貼付け後はクリップボードは空になる
②2回目以降は名前が付けられたセル「kankaku」から取得した数値分、下にずらして張り付けていく
③貼付け位置を変える時はリセットボタンを押す
④マクロ起動中は、コピーしたものはすべてEXCELシートに張り付けられてしまうため、使用が終わったら停止ボタンでマクロを停止する
おーわり