[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Excelにスクショを自動的に張り付けたい』(さはら)
一枚目のスクショをA1のセルに張り付けて、
二枚目以降のセルは一枚目のスクショから
2行ほどずらして張り付けたいです。
以下のコードを参考にしましたが、解決せず。。
御教示頂けませんでしょうか?
以下元のコードです。
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
< 使用 Excel:Excel2010、使用 OS:unknown >
それとも、自分で書いたのではないならば、出典元を明らかにしてください。 他人のコードを、あたかも自分のコードのように公開する事は、著作権違反になりますよ。
そして2行ずらすのは、貼った最後の画像のBottomRightCellプロパティを見るだけかと。
(???) 2020/02/17(月) 17:20
参考HPです。
https://qiita.com/tennisplayer8083tanakatarou/items/b383ed020db656fb8863
(通りすがり) 2020/02/17(月) 17:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.