Excelマクロのオフセットについて
マクロのセルのオフセットについて質問です。
複数の画像（仮に7枚）を一度に張り付ける際に
If ActiveCell.Column = 1 Then
ActiveCell.Offset(, 8).Select
Else
ActiveCell.Offset(4, -8).Select
End If
このようなマクロ組むと
1 2
3 4
5 6
7
という感じになります。
列は8列空いて、行は4行空くことになると思うのですが
これを
1 2 3
4 5 6
7
としたい場合はどのようなマクロの書き方をすればよいのでしょうか？
ご指導の程宜しくお願いします。マクロを張り付けておきます。
Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
Sub 画像一括貼り付け()
Dim Fname As Variant, fe As Variant
Dim Fn As Variant, Pic As Shape
Dim pno As Long
Dim myFileName As String
Range("A8").Select
SetCurrentDirectory "P:\投レ＋相模原\F-POT KBB42365\外観確認"
Fname = Application.GetOpenFilename _
("jpg,*.jpg,jpeg,*.jpeg,bmp,*.bmp,gif,*.gif,png,*.png", MultiSelect:=True)
If Not IsArray(Fname) Then
MsgBox "取り消されました。", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
pno = 0
For Each Fn In Fname
'この次へ追加すべき行
Selection.Offset(-1, 0) = Mid(Fn, InStrRev(Fn, "\") + 1, Len(Fn) - InStrRev(Fn, "\"))
ActiveCell.Select
Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=Fn, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, Top:=0, Width:=360, Height:=270)
With Pic
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
.Top = ActiveCell.Top ' 位置：アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置：アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
End With
If ActiveCell.Column = 1 Then
ActiveCell.Offset(, 8).Select
Else
ActiveCell.Offset(4, -8).Select
End If
Set Pic = Nothing
pno = pno + 1
Next
Application.ScreenUpdating = True
Range("A1").Select
MsgBox pno & "枚の画像を挿入しました", vbInformation
End Sub
お礼
早速ご回答いただき誠に有難う御座いました。 うまくいきました。 中々うまくいかず時間がかかりましたがすぐにできて感激です。 これからもご指導よろしく御願いいたします。