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

回答No.1

keithin · ベストアンサー

どうやっても出来ますが

たとえば１列目と９列目にあったら右に８、そうでなければ下に下がって１６左：
　range("A8").select
　：
　：
’今のマクロの該当部分を丸ごと次のように差し替える
　if activecell.column = 1 or activecell.column = 9 then
　　activecell.offset(0, 8).select
　else
　　activecell.offset(4, -16).select
　end sub
next

お礼

ありがとうございました。

教えて頂いたマクロで目的が果たせました。
回答者様が早く回答を頂けたので
ベストアンサーとさせて頂きます。

回答No.2

chie65536（@chie65535）

If ActiveCell.Column = 1 Then
ActiveCell.Offset(, 8).Select
Else
ActiveCell.Offset(4, -8).Select
End If

を

If ActiveCell.Column = 17 Then
ActiveCell.Offset(4, -16).Select
Else
ActiveCell.Offset(, 8).Select
End If

にします。

アクティブなセルのカラム位置は「1、9、17、1、9、17…」と変化します。

「1なら9に、9なら17に、17なら1に変化」です。

言い換えれば「17でないなら8足して、17なら16引いて」です。

お礼

ありがとうございました。

頂いたマクロで目的の事が出来ました。
また宜しくお願いします。