Excelにエビデンスを張り付けるのを自動化した話。

エビデンス取るのしんどかったので、張り付けるところをVBAで自動化しました。
スクリーンショットに保存した画像を自動でExcelに張り付けています。
以下のGifのようになります。 alt + prt src でウィンドウの画像をスクリーンショットに保存しています。
~~※ Gifミスってたのであとで張り替えます~~
![貼り付け2.gif](https://qiita-image-store.s3.amazonaws.com/0/307024/a7ba6136-11ca-b9f3-e7a7-2732d4a196ee.gif)


VBAは全然触ったことがなく、いろいろなサイトを巡って~~パクリまくった~~たくさん参考にしたのでググったら似たようなコードが出てくると思います。

#使い方とコード
VBAで以下のコードを実行します。
実行状態でクリップボードに画像を保存すると自動でExcelに貼り付けられます。
Windows10なら Windows + shift + s で範囲を選択して画像をクリップボードに保存できます。
終わるときはexitを入力してEnterを押すなり、なにかエラーを起こせば終了できます。


```VisualBasic:画像貼り付け.bas
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に移します。
##クリップボードの処理用にライブラリをインポートします。

```VisualBasic:
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
```
##クリップボードを空にします。

```VisualBasic:
    OpenClipboard
    EmptyClipboard
    CloseClipboard
```
##変数設定をします。

```VisualBasic:
    Dim CB As Variant 'クリップボードの中身を入れる変数
    Dim position As Integer: position = 33 ' 次に画像を張る位置 positionの分だけ下のセルを選択
    Dim size As Double: size = 1 ' 画像サイズ size倍
```
##ループを始めます。

```VisualBasic:
    Do While True
    	'貼り付け処理
    Loop
```
##クリップボードの中身を取得します。

```VisualBasic:
        CB = Application.ClipboardFormats ' 中身は配列
```
##Exitが入力されたら処理を終了します。

```VisualBasic:
        ' 選択しているセルの1つ上にEXITが記入されていたらQuitに行く
        If Not ActiveCell.Row = 1 Then
            If StrConv(ActiveCell.Offset(-1, 0).Value, vbUpperCase) = "EXIT" Then GoTo Quit
        End If
```

```VisualBasic:
Quit:
    MsgBox "停止しました。", vbInformation ' メッセージボックスを出す
    ActiveCell.Offset(-1, 0).ClearContents ' Exitの文字を消す
    GoTo ToEnd 'ToEndの後ろはEnd Subで処理が終わる
```
##エラーがある場合は処理を終了します。

```VisualBasic:
        On Error GoTo ErrorQuit ' エラーがあるときはErrorQuitへいく
```

```VisualBasic:
ErrorQuit:
    MsgBox "予期せぬ動作のため停止しました。", vbInformation ' メッセージボックスを出す
    'この後ろはEnd Subで処理を終わる
```
##クリップボードに画像があったらExcelに貼り付けます。

```VisualBasic:
        For i = 1 To UBound(CB) 'クリップボードの中身の分繰り返す
            If CB(i) = xlClipboardFormatBitmap Then '画像かどうか確認する
                ActiveSheet.Paste ' クリップボードの画像を貼り付ける
            End If
        Next i
```
##画像のサイズを直します。

```VisualBasic:
                Set objShp = ActiveSheet.Shapes(Selection.name) ' 張り付けた画像を選択する
                objShp.LockAspectRatio = msoTrue ' サイズを変更しても元の比率を保持する
                objShp.ScaleHeight size, msoTrue ' 画像サイズをsize倍する
```
##次に画像を張る位置を設定します。

```VisualBasic:
                ActiveCell.Offset(position, 0).Select 'positionだけ下のセルを選択する
```
##クリップボードを空にします。

```VisualBasic:
                OpenClipboard
                EmptyClipboard
                CloseClipboard
```
##制御をOSに移します。
```VisualBasic:
        DoEvents 'ループ中に操作できるようにする
```

終わりです。
#最後に
テスト疲れた……。
コードを書きたい……。