vba, 複数ブックの同一セルに同一写真を挿入
エクセルVBAの初心者です。使っているのはExcel2007です。
同じフォルダの中にある連番の複数のエクセルファイルに同じ操作を繰り返すマクロを作っています。まず、複数ブックの同一セルに同じ内容の文字列を挿入することはどこかで見つけました。
Sub 複数Book同一セルに同一文字列入力()
Dim fName As Variant
Dim i As Long
Dim WB As Workbook
fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True)
If IsArray(fName) Then
For i = LBound(fName) To UBound(fName)
Set WB = Workbooks.Open(fName(i))
WB.Worksheets(1).Range("A1").Value = "テスト"
WB.Close SaveChanges:=True
Next
End If
End Sub
また、選択したセルに同じフォルダの中にある写真を挿入するマクロもどこかで拝見しました。
Sub AddPictureSampLinkPaste()
Dim myFileName As String
Dim myShape As Shape
myFileName = ActiveWorkbook.Path & "\Koala.jpg"
'--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納
Set myShape = ActiveSheet.Shapes.AddPicture( _
Filename:=myFileName, _
LinkToFile:=True, _
SaveWithDocument:=False, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=0, _
Height:=0)
'--(2) 挿入した画像に対して元画像と同じ高さ・幅にする
With myShape
.ScaleHeight 1, msoTrue '数字は写真の高さの倍数
.ScaleWidth 1, msoTrue '数字は写真の幅の倍数
End With
End Sub
ここまではテストで問題なかったので、この二つのマクロを一つにまとめて、同じフォルダにある連番のエクセルブックの同一セルに同一写真を挿入するマクロを作ろうと下記のようにアレンジしましたが、なぜか写真はマクロを記入したブックのアクティブセルに連番のブックの数だけの写真が重なるように貼り付けられるだけで、標的のブックには写真が挿入できません。
Sub 複数Bookの同じ位置に同一写真挿入()
Dim fName As Variant
Dim i As Long
Dim WB As Workbook
Dim myFileName As String
Dim myShape As Shape
fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True)
myFileName = ActiveWorkbook.Path & "\Koala.jpg"
If IsArray(fName) Then
For i = LBound(fName) To UBound(fName)
Set WB = Workbooks.Open(fName(i))
Worksheets("Sheet1").Activate
'--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納
Set myShape = ActiveSheet.Shapes.AddPicture( _
Filename:=myFileName, _
LinkToFile:=True, _
SaveWithDocument:=False, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=0, _
Height:=0)
'--(2) 挿入した画像に対して元画像と同じ高さ・幅にする
With myShape
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
End With
WB.Close SaveChanges:=True
Next
End If
End Sub
本当にどこが間違っているか分からず、ここで質問いたします。初心者で分からないところばかりなので、どなたかやさしく教えていただけませんか？よろしくお願いいたします。
