Skip to content

Instantly share code, notes, and snippets.

@Neos21

Neos21/Module.bas

Last active Feb 17, 2020
Embed
What would you like to do?
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
@Neos21

This comment has been minimized.

Copy link
Owner Author

@Neos21 Neos21 commented Mar 14, 2017

このマクロをブックに仕込んでおき、マクロを実行すると、クリップボードの監視を始める。
PrintScreen キーでスクリーンショットを撮ると、Excel シートに整形して貼り付ける。
Excel シートは幅 20px 程度で方眼紙にしておくとキレイに貼れるかと。
Excel しかない環境でテスト証跡を撮らなきゃいけなくなったときにドウゾ。

@Neos21

This comment has been minimized.

Copy link
Owner Author

@Neos21 Neos21 commented May 13, 2019

@ghost

This comment has been minimized.

Copy link

@ghost ghost commented Feb 17, 2020

一枚目のセルはA1のセルから張り付けて、次のキャプチャーは一枚目のセルから2行開けたい場合はどうすればよろしいでしょうか?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment