途中に画像を挿入マクロ
画像を連続で貼り付けていて、途中で画像を貼り忘れた時に使えそうなマクロを作成。
Sub 途中に画像を挿入マクロ() Dim CB As Variant Dim i As Long Dim lastImg As Integer Dim imgHeight As Double Dim moveCell As Integer Dim cellRow As Long Dim insertRow As Long 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 '行を1行挿入する Rows(ActiveCell.Row).Insert 'セルの移動 ActiveCell.Offset(1, 0).Activate '画像貼り付け ActiveSheet.Paste '最後に貼った画像を選択 lastImg = ActiveSheet.Shapes.Count ActiveSheet.Shapes(lastImg).Select '画像の高さを取得 imgHeight = Selection.Height '現在のセルの行を取得 cellRow = ActiveCell.Row '挿入する行の数を計算 insertRow = imgHeight \ ActiveCell.RowHeight '行を挿入する Range(cellRow + 1 & ":" & (cellRow + insertRow + 1)).Insert 'セルの移動数を計算 moveCell = insertRow + 1 'セルの移動 ActiveCell.Offset(moveCell, 0).Activate Exit For End If Next i End Sub
画像と画像の間にセルを合わせて……。
画像間に挿入される。