こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2015-08-03 15:57:36

QNo.9023679

すぐに回答ほしいです

質問者が選んだベストアンサー

どうやっても出来ますが


たとえば1列目と9列目にあったら右に8、そうでなければ下に下がって16左:
 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

投稿日時 - 2015-08-03 16:19:53

お礼

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

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

投稿日時 - 2015-08-04 10:26:27

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

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引いて」です。

投稿日時 - 2015-08-03 16:26:29

お礼

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

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

投稿日時 - 2015-08-04 10:27:14

あなたにオススメの質問