Excel에 증거를 붙이는 것을 자동화한 이야기.
스크린샷에 저장한 이미지를 자동으로 Excel에 붙여넣습니다.
아래의 Gif와 같습니다. alt + prt src로 창 이미지를 스크린 샷에 저장합니다.
※ Gif 미스 였으므로 나중에 바꿉니다
VBA는 전혀 접한 적이 없고, 여러가지 사이트를 둘러싸고 파크리 뻗은 많이 참고로 했기 때문에 구그하면 비슷한 코드가 나온다고 생각합니다.
사용법 및 코드
VBA에서 다음 코드를 실행합니다.
실행 상태에서 클립보드에 이미지를 저장하면 자동으로 Excel에 붙여넣습니다.
Windows10에서는 Windows + shift + s에서 범위를 선택하여 이미지를 클립보드에 저장할 수 있습니다.
끝나면 exit를 입력하고 Enter 키를 누르면 오류가 발생하면 종료 할 수 있습니다.
이미지 붙여넣기.basDeclare 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 'ループ中に操作できるようにする
끝입니다.
마지막으로
시험 피곤했다…….
코드를 쓰고 싶다…
Reference
이 문제에 관하여(Excel에 증거를 붙이는 것을 자동화한 이야기.), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/snaruse0608/items/4d6022c43e65fe0eee4c
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
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 'ループ中に操作できるようにする
끝입니다.
마지막으로
시험 피곤했다…….
코드를 쓰고 싶다…
Reference
이 문제에 관하여(Excel에 증거를 붙이는 것을 자동화한 이야기.), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/snaruse0608/items/4d6022c43e65fe0eee4c
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
Reference
이 문제에 관하여(Excel에 증거를 붙이는 것을 자동화한 이야기.), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/snaruse0608/items/4d6022c43e65fe0eee4c텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)