エクセルVBAでリストにあるファイルを開いて写真を張り付ける作業一括で行いたいです。

お世話になります。
VBA初級者ですがよろしくお願いいたします。

①ファイルリストにあるファイルを開いて、②指定したフォルダから、③画像を張り付け、④微修正し、⑤保存。

これを繰り返す作業を行いたいです。
（リストは画像参照）

下記は、対象のファイルを開いた状態で、②指定したフォルダから、③画像を張り付け、④微修正し、⑤保存のものです。

これを、①ファイルリストにあるファイルを開いて、②指定したフォルダから、③画像を張り付け、④微修正し、⑤保存し、リストにもとづいて上から順番に繰り返す作業を行いたいです。

Sub 図面貼り付け()
Dim folderPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then folderPath = .SelectedItems(1)
End With
If folderPath = "" Then Exit Sub


Range("B11:F41").Select
ActiveSheet.Shapes.AddPicture _
Filename:=folderPath & "\1.jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left + 17.25, _
Top:=Selection.Top + 15.75, _
Width:=-1, _
Height:=-1 'Selection.Width Selection.Height


Range("G11:K41").Select
ActiveSheet.Shapes.AddPicture _
Filename:=folderPath & "\2.jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left + 19.5, _
Top:=Selection.Top + 14.25, _
Width:=-1, _
Height:=-1 'Selection.Width Selection.Height

ActiveWorkbook.Save
ActiveWindow.Close

End Sub

よろしくお願いいたします。

No.3 ベストアンサー 回答者： iothes00 回答日時： 2020/10/10 20:26

黄色いバーでエラーが出るのでしょうか？

こちらでは出ませんね。

この回答へのお礼

返信ありがとうございます。

黄色バーでエラーが発生します。
（実行時エラー424）

作業内容やファイルを変えてみても同じ症状でした。

お礼日時：2020/10/11 10:05

No.2 回答者： iothes00 回答日時： 2020/10/09 09:08

イメージがわかなくて違うと思いますが

act=activeworkbook.name
for i=2 to 6
workbooks.open range("A" & i)
msgbox workbooks(act).activesheet.range("C" & i)


activeworkbooks.save
activeworkbooks.close
next

これはリストからエクセルを開いて、画像アドレスを表示
保存して閉じるコードです

真ん中空白行にしたいことを書くとできます。

修正しました

この回答へのお礼

回答ありがとうございます。初級者ですいません。下記のような感じでいいのでしょうか。

Sub 図面貼り付け()
Dim folderPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then folderPath = .SelectedItems(1)
End With
If folderPath = "" Then Exit Sub


Range("B11:F41").Select
ActiveSheet.Shapes.AddPicture _
Filename:=folderPath & "\1.jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left + 17.25, _
Top:=Selection.Top + 15.75, _
Width:=-1, _
Height:=-1 'Selection.Width Selection.Height

ActiveWorkbook.Save　←ここでエラー
ActiveWindow.Close

End Sub

おかげさまで、リストのファイル、開きましたがセーブでエラーができます。

現在、フォルダを手動で選択していますが、フォルダリストのフォルダを自動で選択し、写真をはって、セーブして、閉じて、次のファイルといいうような感じで、自動で行いたいです。

お手数おかけしますが
よろしくお願いいたします。

お礼日時：2020/10/10 17:13

No.1 回答者： iothes00 回答日時： 2020/10/09 09:06

イメージがわかなくて違うと思いますが

for i=2 to 6
workbooks.open range("A" & i)
msgbox activeworkbook.activesheet.range("C" & i)


activeworkbooks.save
activeworkbooks.close
next

これはリストからエクセルを開いて、画像アドレスを表示
保存して閉じるコードです

真ん中空白行にしたいことを書くとできます。

この回答へのお礼

activeworkbooks.save
activeworkbooks.close

⇓

activeworkbook.save
activeworkbook.close

に変更したらうまくいきました。
ありがとうございました。

お礼日時：2020/10/19 14:08