画像貼り付けマクロ
キャプチャした画像をExcelに貼っていくマクロを作成した。
Sub 画像貼り付けマクロ() Dim CB As Variant Dim i As Long Dim lastImg As Integer Dim imgHeight As Double Dim moveCell As Integer CB = Application.ClipboardFormats If CB(1) = True Then MsgBox "クリップボードは空です", 48 Exit Sub End If For i = 1 To UBound(CB) If CB(i) = xlClipboardFormatBitmap Then '画像貼り付け ActiveSheet.Paste '最後に貼った画像を選択 lastImg = ActiveSheet.Shapes.Count ActiveSheet.Shapes(lastImg).Select '画像の高さを取得 imgHeight = Selection.Height 'セルの移動数を計算 moveCell = imgHeight \ ActiveCell.RowHeight + 2 'セルの移動 ActiveCell.Offset(moveCell, 0).Activate Exit For End If Next i End Sub
キャプチャした画像を1行ずつ、離しながら
貼り付けることができる。
途中で画像のサイズが変わっても大丈夫。
参考にしたサイト