32
47

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

エビデンス取得マクロツール(スクリーンショットキー押すだけ)

Last updated at Posted at 2017-10-21

#1.出展元はこちら
■t-hom’s diary
VBA スクリーンショットを撮るたびに自動でシートに張り付けるマクロ

規約読みました。
流用させて頂いております。ありがとうございます。

#2.クリップボードに入ったスクリーンショットを自動でExcelに張り付けていくマクロ

AutoCapture()
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
Public LOCALOFFSET As Long

Sub AutoCapture()

    'クリップボードを空にする。
    OpenClipboard
    EmptyClipboard
    CloseClipboard
                    
    MsgBox "AutoCaptureを開始します。" & vbNewLine & _
        "①貼り付け開始位置にカーソルを置いて" & vbCr & _
        "②貼り付け開始位置変える場合はリセットボタン押して" & vbCr & _
        "③このマクロ起動中はエビデンスに全て貼付けられるから注意", vbInformation
    Dim CB As Variant
    Dim IsFirst As Boolean: IsFirst = True
    Do While True
        CB = Application.ClipboardFormats
        If StrConv(ActiveSheet.Cells(1, 1).Value, vbUpperCase) = "EXIT" Then GoTo Quit
        If CB(1) <> -1 Then
            For i = 1 To UBound(CB)
                If CB(i) = xlClipboardFormatBitmap Then
                    If IsFirst = True Then
                        ActiveSheet.Paste Destination:=ActiveCell
                        IsFirst = False
                        LOCALOFFSET = LOCALOFFSET + CInt(Sheets("メニュー").Range("kankaku").Value)
                    Else
                        ActiveSheet.Paste Destination:=ActiveCell.Offset(LOCALOFFSET, 0)
                        LOCALOFFSET = LOCALOFFSET + CInt(Sheets("メニュー").Range("kankaku").Value)
                    End If
                    
                    'クリップボードを空にする。
                    OpenClipboard
                    EmptyClipboard
                    CloseClipboard
                End If
            Next i
        End If
        DoEvents
    Loop
    
Quit:
    MsgBox "AutoCaptureを停止しました。", vbInformation
    ActiveSheet.Cells(1, 1).ClearContents
End Sub


reset()
'貼付け位置をリセット
Sub reset()
    LOCALOFFSET = 0
    MsgBox "リセットしたよ"
End Sub

stopMacro()
'マクロを停止する
Sub stopMacro()
    MsgBox "マクロを停止したよ"
    End
End Sub

#3.使用準備
①Alt+F11でVBEを開きシートでも標準モジュールでもいい標準モジュールに上記マクロを貼り付ける※Option Explicitの宣言がある場合は宣言を削除する
②シート名を「メニュー」とし、そこに以下キャプチャの様な感じでボタンを作成。マクロとボタンを関連付ける
・「開始」ボタンに「AutoCapture()」を登録する
・「停止」ボタンに「stopMacro()」を登録する
・「リセット」ボタンに「reset()」を登録する
③どこでもいいのでセルに「kankaku」という名前を付ける

WS000000.JPG

#4.あとは使うだけ!
①マクロを開始し、スクリーンショットでキャプチャを取るとセルのカーソルが置いてある場所に張り付けられる。※貼付け後はクリップボードは空になる
②2回目以降は名前が付けられたセル「kankaku」から取得した数値分、下にずらして張り付けていく
③貼付け位置を変える時はリセットボタンを押す
④マクロ起動中は、コピーしたものはすべてEXCELシートに張り付けられてしまうため、使用が終わったら停止ボタンでマクロを停止する

#5.使ったらこんな感じ
WS000001.JPG

おーわり

32
47
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
32
47

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?