testファイル内にある複数のpngファイルを昇順に１スライド１枚ずつパワポに貼り付けたい

VBA初心者です。

タイトルにある通り、testファイル内にある複数のpngファイルを昇順に１スライド１枚ずつPowerPointに貼り付けたいと考えています。
ただ、下記を実行すると昇順ではなくランダムに貼り付けされてしまい困ってます。

どなたか解決策ご存じでしたら教えてください…！


_______
Sub パワポに写真を一括貼り付け()

Dim ppPres As PowerPoint.Presentation
Dim ppApp As PowerPoint.Application
Dim folderPath As String
Dim extensions() As Variant
Dim i As Integer
Dim fileName As String
Dim ppSlide As PowerPoint.Slide

'PowerPointアプリケーションを開始
Set ppApp = New PowerPoint.Application

'新しいプレゼンテーションを作成
Set ppPres = ppApp.Presentations.Add

'指定のフォルダから画像を読み込む
folderPath = "C:\work\test"

'拡張子の配列を定義
extensions = Array("png")

'画像を格納する
For i = LBound(extensions) To UBound(extensions)

'画像のファイル名を取得
fileName = Dir(folderPath & "\*." & extensions(i))

'画像を1枚ずつ読み込んでスライドに貼り付け
While fileName <> ""
'新しいスライドを作成
Set ppSlide = ppPres.Slides.Add(ppPres.Slides.Count + 1, ppLayoutBlank)

'画像を貼り付け
ppSlide.Shapes.AddPicture folderPath & "\" & fileName, msoFalse, msoTrue, 0, 0

'次の画像のファイル名を取得
fileName = Dir()
Wend
Next i

'PowerPointを表示
ppApp.Visible = True

End Sub
________

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

• Sub グラフを画像に変換2()
  　Dim targetWorkbook As Workbook
  　Dim targetSheet As Worksheet
  　 '貼り付け元のファイルパス、シートを指定
  　Set targetWorkbook = Workbooks.Open(" ") ※現場のファイルパス
  　Set targetSheet = targetWorkbook.Sheets("3ヵ月グラフ_1")
  
  　' Excelをアクティブにする
  　'// ズームを100%に戻す（出力する画像サイズはズームに影響するため）
  　targetSheet.Activate
  　ActiveWindow.Zoom = 100
  
  　Dim co As ChartObject
  　Dim sFolder As String

    補足日時：2025/03/03 22:52

• Dim sExtension As String
  　Dim sAddress As String
  　Dim c As Chart
  　Dim i As Long
  　 ' ファイル作成
  　MkDir "C:\work\test"
  　'アクティブシートの全グラフをループ
  　Do Until i = 43
  　For Each co In targetSheet.ChartObjects
  　'現ループのグラフがあるセル座標を取得
  　sAddress = co.TopLeftCell.Address
  　Range(sAddress).Select
  　'Chartオブジェクトを取得
  　Set c = co.Chart

    補足日時：2025/03/03 22:53

• 'ブックがあるフォルダを画像ファイル出力先フォルダとして取得
  sFolder = "C:\work\test"
  
  '画像拡張子を設定
  sExtension = ".png"
  
  '画像出力
  Call c.Export(sFolder & "\" & i & sExtension)
  i = i + 1
  Next
  Loop
  
  End Sub

    補足日時：2025/03/03 22:54

• こんばんは。
  回答ありがとうございます。
  
  記載いただいた内容を試したことで原因がわかりました。
  
  そもそも、補足に記載した内容で出力したファイル名に問題がありました。
  そのため、質問を変更させてください。
  
  【フォルダ内の名前を一意にしたいです】
  現状:フォルダ内に 1→2→3.. →10→11→12 とファイルが出力された後、パワポに1→2→3 と貼り付けを行いたいが、1→10→11 と貼り付けされる
  
  pngファイルを01,02〜と一意の名前で出力する方法を教えていただくことは可能でしょうか？

  No.2の回答に寄せられた補足コメントです。 補足日時：2025/03/03 22:56

• こんばんは。
  添削ありがとうございます。
  
  記載いただいた内容を試したことで原因がわかりました。
  
  >>勘違いでなく？ランダム・・・ランダムにpngファイルを読み込む　処理はされていまいと思いますが・・・
  仰るとおりでした。そもそも、補足に記載した内容で出力したファイル名に問題がありました。
  そのため、質問を変更させてください。
  
  【フォルダ内の名前を一意にしたいです】
  現状:フォルダ内に 1→2→3.. →10→11→12 とファイルが出力された後、パワポに1→2→3 と貼り付けを行いたいが、1→10→11 と貼り付けされる
  
  pngファイルを01,02〜と一意の名前で出力する方法を教えていただくことは可能でしょうか？

  No.1の回答に寄せられた補足コメントです。 補足日時：2025/03/03 22:59

• 

  何度もすみません。
  上記の質問も解決しました。
  
  間違いに気づくことができたのはお二方のおかげです。
  誠にありがとうございました。

    補足日時：2025/03/04 00:05

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2025/03/04 02:34

こんばんは

すべて自己解決されたと言う事で良かったです
回答部分が無いので後の方の為に一応追記の回答を書きます

＞1→2→3 と貼り付けを行いたいが、1→10→11 と貼り付けされる
＞出力したファイル名に問題がありました。

ファイル名は文字列なので数値として1→2→3...10→11とはならない為
1→10→11..19→2→20→21となります（左の文字が優先

番号のみのファイル名を同じ桁の文字にすれば解消されます
3桁までなら　001→002→003...010→011

自己解決
＞pngファイルを01,02〜と一意の名前で出力する方

下記に同様の質問回答がありました
https://oshiete.goo.ne.jp/qa/5170582.html

追記で示されているコードの場合（ファイル作成時）
Call c.Export(sFolder & "\" & Format(i, "00") & sExtension)

条件が付きますが取得側で行う場合 1→2→3...10→11
ファイル名が数値のみ　もしくは　数値＆文字列　で数値を優先して昇順にする場合
　#1 の回答コードで配列ソートの比較部分を
If Val(arrFileName(j)) > Val(arrFileName(j + 1)) Then
とすることでも可能かと思います

もちろんファイル作成時に行うのが理想的です

この回答へのお礼

補足の回答までありがとうございます…！
私はif文で10以下は0を付け足すような処理をしたのですが、いただいている方が汎用性が高そうなので使わせていただきます。
誠にありがとうございました。

お礼日時：2025/03/04 22:15

No.2 回答者： fujillin 回答日時： 2025/03/03 21:26

こんばんは

＞昇順ではなくランダムに貼り付けされてしまい困ってます。
通常、Dir関数で取得するファイル名は昇順になっていると思いますが、ご提示のコードをそのまま実行してもランダムになるのでしょうか？
もしかすると、拡張子を複数設定したらランダムのようにに見えるという意味のご質問でしょうか？
（実際には、ランダムではないはずですが・・）

もしもそうであるなら、原因は、拡張子でのループが外側になっているため、結果の順序として「拡張子順」-「名前順」という順序になっているのではないかと想像します。


対策として、No1様の回答にあるように、該当するファイルを一旦配列に記録して、ソートし直してから出力することでも可能です。
とは言え、そのようなことをしなくても、前述のようにDir関数が名前順に取得することを利用すれば、ほぼご提示のままでも可能と思います。

具体的には、Dir関数のループを外側にして、拡張子を指定しないでファイル名を取得します。
その上で、そのファイルが指定拡張子と合致していたら採用する（＝合致していなければスキップ）というような処理手順に変えることで、ファイルを配列に記録するようなことをしなくてもすむはずと思います。

この回答へのお礼

お礼日時：2025/03/04 00:06

No.1 回答者： Qchan1962 回答日時： 2025/03/03 19:28

＞昇順ではなくランダムに貼り付けされてしまい困ってます。

勘違いでなく？ランダム・・・ランダムにpngファイルを読み込む　処理はされていまいと思いますが・・・

pngファイル名で昇順ソートをしてからShapes.AddPicture メソッドを行うように添削してみました

今PowerPointの入っていない端末からなのでデバッグ（検証）は行っておりません
走り書き程度に考えて試してください

Sub パワポに写真を一括貼り付け()

Dim ppPres As PowerPoint.Presentation
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim folderPath As String
Dim arrFileName() As Variant
Dim i As Integer, j As Integer, v As Variant
Dim fileName As String

'PowerPointアプリケーションを開始
Set ppApp = New PowerPoint.Application
'新しいプレゼンテーションを作成
Set ppPres = ppApp.Presentations.Add

'指定のフォルダパスを設定
folderPath = "C:\work\test"

'画像のファイル名を取得
fileName = Dir(folderPath & "\*.png")

'ファイル名を取得して配列を作成
While fileName <> ""
ReDim Preserve arrFileName(n)
arrFileName(i) = fileName
i = i + 1
fileName = Dir()
Wend

'Sort > 昇順
For i = UBound(arrFileName) To LBound(arrFileName) Step -1
For j = LBound(arrFileName) To i - 1
If arrFileName(j) > arrFileName(j + 1) Then
v = arrFileName(j)
arrFileName(j) = arrFileName(j + 1)
arrFileName(j + 1) = v
End If
Next
Next

'画像を1枚ずつ読み込んでスライドに貼り付け
For i = LBound(arrFileName) To UBound(arrFileName)
'新しいスライドを作成
Set ppSlide = ppPres.Slides.Add(ppPres.Slides.Count + 1, ppLayoutBlank)
'画像を貼り付け
ppSlide.Shapes.AddPicture folderPath & "\" & arrFileName(i), msoFalse, msoTrue, 0, 0
Next

'PowerPointを表示
ppApp.Visible = True

End Sub

この回答へのお礼

お礼日時：2025/03/04 00:06