エビデンス取るのしんどかったので、張り付けるところをVBAで自動化しました。
スクリーンショットに保存した画像を自動でExcelに張り付けています。
以下のGifのようになります。 alt + prt src でウィンドウの画像をスクリーンショットに保存しています。
※ Gifミスってたのであとで張り替えます
VBAは全然触ったことがなく、いろいろなサイトを巡ってパクリまくったたくさん参考にしたのでググったら似たようなコードが出てくると思います。
使い方とコード
VBAで以下のコードを実行します。
実行状態でクリップボードに画像を保存すると自動でExcelに貼り付けられます。
Windows10なら Windows + shift + s で範囲を選択して画像をクリップボードに保存できます。
終わるときはexitを入力してEnterを押すなり、なにかエラーを起こせば終了できます。
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
Sub クリップボードにコピーした画像を貼り付ける()
OpenClipboard
EmptyClipboard
CloseClipboard
Dim CB As Variant
Dim position As Integer: position = 33
Dim size As Double: size = 1
Do While True
CB = Application.ClipboardFormats
If Not ActiveCell.Row = 1 Then
If StrConv(ActiveCell.Offset(-1, 0).Value, vbUpperCase) = "EXIT" Then GoTo Quit
End If
On Error GoTo ErrorQuit
For i = 1 To UBound(CB)
If CB(i) = xlClipboardFormatBitmap Then
ActiveSheet.Paste
Set objShp = ActiveSheet.Shapes(Selection.name)
objShp.LockAspectRatio = msoTrue
objShp.ScaleHeight size, msoTrue
ActiveCell.Offset(position, 0).Select
OpenClipboard
EmptyClipboard
CloseClipboard
End If
Next i
DoEvents
Loop
Quit:
MsgBox "停止しました。", vbInformation
ActiveCell.Offset(-1, 0).ClearContents
GoTo ToEnd
ErrorQuit:
MsgBox "予期せぬ動作のため停止しました。", vbInformation
ToEnd:
End Sub
コードの解説
流れは以下の通りです。
クリップボードの処理用にライブラリをインポートします。
クリップボードを空にします。
変数設定をします。
ループを始めます。
クリップボードの中身を取得します。
もし、Exitが入力されたら処理を終了します。
エラーがある場合は処理を終了します。
クリップボードに画像があったらExcelに貼り付けます。
画像のサイズを直します。
次に画像を張る位置を設定します。
クリップボードを空にします。
制御をOSに移します。
クリップボードの処理用にライブラリをインポートします。
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
クリップボードを空にします。
OpenClipboard
EmptyClipboard
CloseClipboard
変数設定をします。
Dim CB As Variant 'クリップボードの中身を入れる変数
Dim position As Integer: position = 33 ' 次に画像を張る位置 positionの分だけ下のセルを選択
Dim size As Double: size = 1 ' 画像サイズ size倍
ループを始めます。
Do While True
'貼り付け処理
Loop
クリップボードの中身を取得します。
CB = Application.ClipboardFormats ' 中身は配列
Exitが入力されたら処理を終了します。
' 選択しているセルの1つ上にEXITが記入されていたらQuitに行く
If Not ActiveCell.Row = 1 Then
If StrConv(ActiveCell.Offset(-1, 0).Value, vbUpperCase) = "EXIT" Then GoTo Quit
End If
Quit:
MsgBox "停止しました。", vbInformation ' メッセージボックスを出す
ActiveCell.Offset(-1, 0).ClearContents ' Exitの文字を消す
GoTo ToEnd 'ToEndの後ろはEnd Subで処理が終わる
エラーがある場合は処理を終了します。
On Error GoTo ErrorQuit ' エラーがあるときはErrorQuitへいく
ErrorQuit:
MsgBox "予期せぬ動作のため停止しました。", vbInformation ' メッセージボックスを出す
'この後ろはEnd Subで処理を終わる
クリップボードに画像があったらExcelに貼り付けます。
For i = 1 To UBound(CB) 'クリップボードの中身の分繰り返す
If CB(i) = xlClipboardFormatBitmap Then '画像かどうか確認する
ActiveSheet.Paste ' クリップボードの画像を貼り付ける
End If
Next i
画像のサイズを直します。
Set objShp = ActiveSheet.Shapes(Selection.name) ' 張り付けた画像を選択する
objShp.LockAspectRatio = msoTrue ' サイズを変更しても元の比率を保持する
objShp.ScaleHeight size, msoTrue ' 画像サイズをsize倍する
次に画像を張る位置を設定します。
ActiveCell.Offset(position, 0).Select 'positionだけ下のセルを選択する
クリップボードを空にします。
OpenClipboard
EmptyClipboard
CloseClipboard
制御をOSに移します。
DoEvents 'ループ中に操作できるようにする
終わりです。
最後に
テスト疲れた……。
コードを書きたい……。