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
お礼
どうにか複数の罫線を同時に表示させることができました。 またまた、ありがとうございました。 感謝しています。では。
補足
>Set myShp = ActiveSheet.Shapes.AddLine(L1, T1, L2, T2) これ、削除するんじゃなかった????(^^;;; すみません最初に質問したコードを貼り付けてしまったもので。 >14行目と15行目の間ではなくて、15行目の枠線上に引かれますよね。 そのとおりです。 この罫線と(1)セルA10の上端から、セルC14の上端へ引く の計2本の罫線を同時に引きたいという内容でした。 言葉足らずで申し訳ありませんでした。