PR
くぴん７４
くぴんのブログへようこそ！ 計算力学１級を持っているＣＡＥエンジニアです。読んだ本の紹介を中心に日々の出来事などを綴っています。
フリーページ
おすすめCD
DREAM THEATER
EXTREME
DEF LEPPARD
MR.BIG
METALLICA
MEGADETH
LOSTPROPHETS
HOOBASTANK
TRAPT
FOO FIGHTERS
EAGLES
System Of A Down
ローンの計算方法
橘玲
クレジットカードのしくみ
大切な言葉集
この世界を混乱に導く悪魔のルール
ETF140銘柄チャート画像取得マクロ
エクセルVBAで高速フーリエ変換
株・資産運用
1.株式会社の始まり
2.資産形成の方程式
3.利回りに対する理解
4.単利と複利
5.債券価格
6.キャピタルゲインとインカムゲイン
7.株式投資の投資戦略
8.BS(貸借対照表)とPL(損益計算書)の関係
9.リスクと不確実性について
10.72の法則
11.家賃から物件価格を推定する方法
12.レバレッジ
13.ファンダメンタル指標
14.サラリーマンの生涯賃金
15.BPS+EPS×10の有効性
16. 裁定取引 (arbitrage)
fortran90で高速フーリエ変換
カレンダー
2026～27主力株概況4…
みきまるファンドさん
DOW 51561.93 +874.8… どらりん0206さん
楽天ラッキーくじ更…
じゃっかすさん
自分を愛することは… まりあのじいじさん
パワーアシストロボ… jhiranoさん
DOW 51561.93 +874.8… どらりん0206さん
楽天ラッキーくじ更…
じゃっかすさん自分を愛することは… まりあのじいじさん
パワーアシストロボ… jhiranoさん
キーワードサーチ
▼キーワード検索
2018年01月26日
テーマ： VBAマクロ集(1)
カテゴリ： プログラミング
大量の画像をパワーポイントに貼付ける必要があり、"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
-----ここまで
お役に立てば幸いです。
にほんブログ村
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
-----ここまで
お役に立てば幸いです。
にほんブログ村
お気に入りの記事を「いいね！」で応援しよう
[プログラミング] カテゴリの最新記事
-
人口動態シミュレーション python x ChatG… 2026年05月30日
-
Android テトリス風ゲーム Pocket Blocks … 2026年05月09日
-
Pyxel Python向けレトロゲームエンジン 2024年01月08日
Re:パワーポイント 画像挿入 マクロ VBA(01/26)
ハムハム さん
初めまして。VBA初心者です。同じような操作をしたいと考えております。
画像フォルダの選択の場所にはどのように打ち込めば良いでしょうか？
例えばデスクトップに保存している画像フォルダ内の画像を全て貼りたいと考えているのですが。
お返事いただければ幸いです。 (2020年01月09日 17時10分32秒)
画像フォルダの選択の場所にはどのように打ち込めば良いでしょうか？
例えばデスクトップに保存している画像フォルダ内の画像を全て貼りたいと考えているのですが。
お返事いただければ幸いです。 (2020年01月09日 17時10分32秒)
Re:パワーポイント 画像挿入 マクロ VBA(01/26)
ハムハム さん
Re[1]:パワーポイント 画像挿入 マクロ VBA(01/26)
ハムハムさんへ
コメントありがとうございます。
返信遅くなり申し訳ありません。
以下が該当箇所ですが、実行してここに来た時に、デスクトップフォルダを指定すればいいはずです。
'画像フォルダ取得
Set fol = CreateObject("Shell.Application") _
.BrowseForFolder(0， "画像フォルダ選択"， &H10， 0)
If fol Is Nothing Then GoTo Fin
fol_path = fol.Self.Path
もし、ダイアログなしでデスクトップフォルダを指定したければ、
'画像フォルダ取得
fol_path = "C:\Users\username\Desktop"
のようにします。 (2020年01月27日 21時29分31秒)
コメントありがとうございます。
返信遅くなり申し訳ありません。
以下が該当箇所ですが、実行してここに来た時に、デスクトップフォルダを指定すればいいはずです。
'画像フォルダ取得
Set fol = CreateObject("Shell.Application") _
.BrowseForFolder(0， "画像フォルダ選択"， &H10， 0)
If fol Is Nothing Then GoTo Fin
fol_path = fol.Self.Path
もし、ダイアログなしでデスクトップフォルダを指定したければ、
'画像フォルダ取得
fol_path = "C:\Users\username\Desktop"
のようにします。 (2020年01月27日 21時29分31秒)
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
