Excel에 증거를 붙이는 것을 자동화한 이야기.

증거를 취하는 것이 힘들었기 때문에, 붙이는 곳을 VBA로 자동화했습니다.
스크린샷에 저장한 이미지를 자동으로 Excel에 붙여넣습니다.
아래의 Gif와 같습니다. alt + prt src로 창 이미지를 스크린 샷에 저장합니다.
※ Gif 미스 였으므로 나중에 바꿉니다


VBA는 전혀 접한 적이 없고, 여러가지 사이트를 둘러싸고 파크리 뻗은 많이 참고로 했기 때문에 구그하면 비슷한 코드가 나온다고 생각합니다.

사용법 및 코드



VBA에서 다음 코드를 실행합니다.
실행 상태에서 클립보드에 이미지를 저장하면 자동으로 Excel에 붙여넣습니다.
Windows10에서는 Windows + shift + s에서 범위를 선택하여 이미지를 클립보드에 저장할 수 있습니다.
끝나면 exit를 입력하고 Enter 키를 누르면 오류가 발생하면 종료 할 수 있습니다.

이미지 붙여넣기.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로 옮깁니다.

클립보드 처리를 위해 라이브러리를 가져옵니다.


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

클립보드를 비웁니다.


    OpenClipboard
    EmptyClipboard
    CloseClipboard

변수 설정을 합니다.


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

루프를 시작합니다.


    Do While True
        '貼り付け処理
    Loop

클립보드의 내용을 가져옵니다.


        CB = Application.ClipboardFormats ' 中身は配列

Exit가 입력되면 처리를 종료합니다.


        ' 選択しているセルの1つ上にEXITが記入されていたらQuitに行く
        If Not ActiveCell.Row = 1 Then
            If StrConv(ActiveCell.Offset(-1, 0).Value, vbUpperCase) = "EXIT" Then GoTo Quit
        End If
Quit:
    MsgBox "停止しました。", vbInformation ' メッセージボックスを出す
    ActiveCell.Offset(-1, 0).ClearContents ' Exitの文字を消す
    GoTo ToEnd 'ToEndの後ろはEnd Subで処理が終わる

오류가 있으면 처리를 종료합니다.


        On Error GoTo ErrorQuit ' エラーがあるときはErrorQuitへいく
ErrorQuit:
    MsgBox "予期せぬ動作のため停止しました。", vbInformation ' メッセージボックスを出す
    'この後ろはEnd Subで処理を終わる

클립보드에 이미지가 있으면 Excel에 붙여넣습니다.


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

이미지의 크기를 수정합니다.


                Set objShp = ActiveSheet.Shapes(Selection.name) ' 張り付けた画像を選択する
                objShp.LockAspectRatio = msoTrue ' サイズを変更しても元の比率を保持する
                objShp.ScaleHeight size, msoTrue ' 画像サイズをsize倍する

그런 다음 이미지가 펼쳐지는 위치를 설정합니다.


                ActiveCell.Offset(position, 0).Select 'positionだけ下のセルを選択する

클립보드를 비웁니다.


                OpenClipboard
                EmptyClipboard
                CloseClipboard

제어를 OS로 옮깁니다.


        DoEvents 'ループ中に操作できるようにする

끝입니다.

마지막으로



시험 피곤했다…….
코드를 쓰고 싶다…

좋은 웹페이지 즐겨찾기