excelのマクロについて教えて下さい。（初心者です）その２

前に、画像貼り付けマクロについて質問したものです。
ある程度の解決を見ましたが、今度は画像を張り付ける際に、サブディレクトリから画像を選択し
貼り付けしているわけですが、選択する際にメインディレクトリに戻ってしまいます。
excel2003では、サブディレクトリを維持したまま何枚でも貼り付けが可能でしたが何か方法が
ありますでしょうか？

質問者からの補足コメント

• 大変失礼をいたしました。
  前回の質問のURLを添付いたします。
  
  https://oshiete.goo.ne.jp/qa/9012483.html

  No.2の回答に寄せられた補足コメントです。 補足日時：2015/09/27 19:02

• 

  お騒がせして申し訳ありませんでした。
  何とか自力で解決できそうです。
  
  ただ、対処の方法が合っているかは分かりませんが
  いろいろありがとうございました。

    補足日時：2015/09/28 20:12

No.2 ベストアンサー 回答者： moto_koukousei 回答日時： 2015/09/27 12:44

｢画像貼り付けマクロについて｣の｢前の質問｣がなにかわかるように、例えば、質問履歴がわかるようにするか、あるいは、前の質問のURLを貼っておくのかしないと、どんなことをやろうとしているのかもわかりません。

｢サブディレクトリから画像を選択し貼り付けしている｣という状況もイメージがわきません。　メインディレクトリとサブディレクトリの言葉から、いくつか下層のディレクトリ（フォルダ）の中のファイルを対象にしているらしいことは想像出来ますが、その先も、最終的にどうしようとしているのかもわかりません。

参照設定　Microsoft Scripting Runtime　をしておくことが出来るのでしたら、
下記のマクロでも、("D:\testFolder\testImageF")の中の複数のフォルダやさらに再下層のフォルダの中の添え字が("jpg")あるいは("JPG")のファイルを、エクセルの現在表示してるシートに小さなサイズで並べることは出来ます。


Sub macro2()
Dim objFSO As FileSystemObject, Retu As Long, Syu As String
Set objFSO = New FileSystemObject ' FSO
Retu = 4: Syu = LCase("jpg")
Tg_Path = LCase("D:\testFolder\testImageF")
Call File_HARI(objFSO, objFSO.GetFolder(Tg_Path), Retu, Syu)
Set objFSO = Nothing
End Sub


Private Sub File_HARI(objFSO As FileSystemObject, _
ByVal objFolder As Folder, _
Retu As Long, Syu As String)
Dim objFolder2 As Folder, objFile As File
For Each objFolder2 In objFolder.SubFolders
Call File_HARI(objFSO, objFolder2, Retu, Syu)
Next objFolder2
GYO = 5
Retu = Retu + 1
Cells(GYO, Retu) = objFolder.Path
For Each objFile In objFolder.Files
With objFile ' 拡張子を確認し、該当ならシートに貼り付け
If LCase(objFSO.GetExtensionName(.Path)) = Syu Then
GYO = GYO + 1
Cells(GYO, Retu) = .Name
GYO = GYO + 1
ActiveSheet.Pictures.Insert(.Path).Select
With Selection
.Top = Cells(GYO, Retu).Top
.Left = Cells(GYO, Retu).Left
.ShapeRange.Height = 35.5
.ShapeRange.Width = 61#
End With
GYO = GYO + 3
End If
End With
Next objFile
End Sub

No.1 回答者： moto_koukousei 回答日時： 2015/09/26 23:09

状況がよくわかりません。

ただ、あるディレクトリにあるjpg画像を、activesheetに貼り付けるだけならば、次のようなマクロでも動きます。
(ネットワークドライブのサブフォルダの中の写真なので遅いですが）
Sub Macro1()
For i = 1 To 12
myName = "Y:\70XZR3\131_FUJI\DSCF1" & Right("000" & i, 3) & ".jpg"
ActiveSheet.Pictures.Insert(myName).Select
myRow = 3 + i * 4
With Selection
.Top = Cells(myRow, i + 6).Top
.Left = Cells(myRow, i + 7).Left
.ShapeRange.Height = 35.5
.ShapeRange.Width = 61#
End With
Next i
End Sub