Excel シートにスクリーンショットを自動貼り付けするマクロ

Excel しかない環境でテスト証跡を撮らなきゃいけない仕事をしているときなどにドウゾ。

' キャプチャ収集状態なら True
Private isLogging As Boolean

' キャプチャを貼り付けるブック名を保持する
Private fileName As String

' キャプチャを取得する
Private Sub Capture()
  On Error Goto errorHandler
  
  ' クリップボードに画像が格納されていたら貼り付ける
  If Application.ClipboardFormats(1) = xlClipboardFormatBitmap Then
    Dim rows As Integer : rows = 54  ' 行数
    Dim cols As Integer : cols = 72  ' 列数
    
    ' キャプチャを貼り付けるブックを選択する
    Workbooks(fileName).Activate
    
    ' 選択しているセルを基準セルとして取得する
    Dim baseCell As Variant
    Set baseCell = Selection
    
    ' 下線を引く
    Range(baseCell.Offset(rows, 1), baseCell.Offset(rows, cols + 1)).Select
    With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlThin
    End With
    
    ' 見出し用の記号をセットする
    baseCell.Offset(2, 2).Value = "■"
    
    ' キャプチャ取得日時をセットする
    With baseCell.Offset(2, cols - 1)
      .HorizontalAlignment = xlRight
      .Value = "取得日時 : " & Now
    End With
    
    ' クリップボードのデータを貼り付け、行数に合わせて縮小する
    baseCell.Offset(4, 3).Select
    ActiveSheet.Paste
    With Selection.ShapeRange
      .LockAspectRatio = msoTrue
      .Height = .Height * 0.7
    End With
    
    ' 次の画像を貼るために基準セルを移動し、クリップボードに現在のセルの値をコピーする (先頭を Bitmap でなくすため)
    With baseCell.Offset(rows + 1, 0)
      .Select
      .Copy
    End With
    
    ' 切り取り・コピーモードを解除する
    Application.CutCopyMode = False
    
    ' 改ページ設定をする
    ActiveSheet.HPageBreaks.Add Before:=ActiveCell
  End If
  
  ' 1秒間隔で再実行するようタイマーをセットする
  Application.OnTime Now + TimeValue("00:00:01"), "Capture", , isLogging
  
  Exit Sub

errorHandler:
  isLogging = False

End Sub

' キャプチャを開始する
Sub StartCapture()
  MsgBox "キャプチャの取得を開始します。終了時は Esc キーを押下してください。"
  
  ' Esc キーで停止できるようにしておく
  Application.OnKey "{ESC}", "StopCapture"
  
  ' キャプチャを貼り付けるブック名を取得する
  fileName = ActiveWorkbook.Name
  
  ' キャプチャ取得状態を設定する
  isLogging = True
  
  ' キャプチャの取得を開始する
  Capture
End Sub

' キャプチャを終了する
Sub StopCapture()
  If isLogging = True Then
    ' キャプチャの取得状態を解除する
    isLogging = False
    
    ' Esc キーへの登録を解除する
    Application.OnKey "{ESC}", ""
    
    MsgBox "キャプチャの取得を停止しました。"
  End If
End Sub

このマクロをブックに仕込んでおき、マクロを実行すると、クリップボードの監視を始める。

PrintScreen キーでスクリーンショットを撮ると、Excel シートに整形して貼り付ける。シート上のカーソル位置も自動で動かすので、順次打鍵していくだけで OK。

Excel シートは幅 20px 程度で方眼紙にしておくとキレイに貼れるかと。あまりにも PrintScreen キーの連打が速いと追い付かないので、1・2秒は開けて打鍵するとよろし。