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 |
This comment has been minimized.
This comment has been minimized.
This comment has been minimized.
This comment has been minimized.
一枚目のセルはA1のセルから張り付けて、次のキャプチャーは一枚目のセルから2行開けたい場合はどうすればよろしいでしょうか? |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This comment has been minimized.
このマクロをブックに仕込んでおき、マクロを実行すると、クリップボードの監視を始める。
PrintScreen キーでスクリーンショットを撮ると、Excel シートに整形して貼り付ける。
Excel シートは幅 20px 程度で方眼紙にしておくとキレイに貼れるかと。
Excel しかない環境でテスト証跡を撮らなきゃいけなくなったときにドウゾ。