くぴんのブログ

プロフィール

くぴん７４

フォローする

フリーページ

家電

(1)

バックナンバー

2026年06月
2026年05月
2026年04月

2026年03月
2026年02月

お気に入りブログ

2026～27主力株概況4… みきまるファンドさん

DOW 51561.93 +874.8… どらりん0206さん

楽天ラッキーくじ更…

じゃっかすさん

自分を愛することは… まりあのじいじさん
パワーアシストロボ… jhiranoさん

ニューストピックス

キーワードサーチ

▼キーワード検索

< 新しい記事

新着記事一覧(全5206件)

過去の記事 >

2018年01月26日

大量の画像をパワーポイントに貼付ける必要があり、"ppt 画像挿入マクロ"でググると以下のサイトが見つかった。

https://www.ka-net.org/blog/?p=8228

これを少し編集し、タイトルにファイルパス、テキストとして"サンプル"を挿入するようにしてみた。画像はpngのみを対象としている。1つのスライドに1枚の画像が挿入される。

-----ここから
Sub InsertImages()
'指定したフォルダ内の画像ファイルを一括挿入
Dim prs As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim txt As PowerPoint.Shape

Dim fol As Object, f As Object
Dim fol_path As String
'開いているプレゼンテーションをprsに格納
Set prs = ActivePresentation

'スライドショー表示になっていたら解除
If SlideShowWindows.Count > 0 Then prs.SlideShowWindow.View.Exit

With ActiveWindow
tmp = .ViewType 'ウィンドウの表示モード記憶
.ViewType = ppViewSlide
End With

'画像フォルダ取得

.BrowseForFolder(0, "画像フォルダ選択", &H10, 0)
If fol Is Nothing Then GoTo Fin
fol_path = fol.Self.Path

'フォルダ内のファイル処理
With CreateObject("Scripting.FileSystemObject")

For Each f In .GetFolder(fol_path).Files
'PNGファイルのみ処理
Select Case LCase(.GetExtensionName(f.Path))
Case "png"
'スライド追加
Set sld = prs.Slides.Add(prs.Slides.Count + 1, ppLayoutChartAndText)
sld.Select
'画像挿入
Set shp = sld.Shapes.AddPicture(FileName:=f.Path, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, _
Top:=0)
With shp
.LockAspectRatio = True '縦横比を固定

.Select
'画像サイズ変更
.Width = .Width * 0.85
.Height = .Height * 0.85
End With

'画像をスライド中央に配置
With ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With
End Select
'スライドタイトルをファイルパスに変更
sld.Shapes(1).TextFrame.TextRange.Text = f.Path
'テキスト挿入
Set txt = sld.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=600, _
Top:=50, _
Width:=250, _
Height:=10)
With txt
.Name = "AddedTextBox"
.TextFrame.TextRange = "サンプル"
.TextEffect.FontSize = 20
End With
Next
End With
Fin:
ActiveWindow.ViewType = tmp 'ウィンドウの表示モードを元に戻す
End Sub
-----ここまで

お役に立てば幸いです。