質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

11805閲覧

Powerpoint VBA 画像差し替えマクロ

xu0124

総合スコア31

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2016/11/27 04:12

編集2016/11/27 12:55

###前提・実現したいこと

画像差し替えマクロの作成

画像複数挿入2000_2
http://oshiete.goo.ne.jp/qa/4490706.html

こちらのベストアンサーのマクロで作成したパワポデータの画像を差し替えたい場合に
コードを改造して、「画像差し替え用のマクロ」を作成したいです

① スライドはもうあるので、新規スライドは作成しない
② まず挿入されている画像は削除して、同じ位置に画像を追加

shp.Delete
Set shp = Sld.Shapes.AddPicture("C:\Users\Luiz\Pictures\Caio\DSC01531.JPG", _
msoFalse, msoCTrue, l, t, w, h)
最終的にはダイアログで選択した画像数分の画像差し替えをしたいです。

###発生している問題・エラーメッセージ

###該当のソースコード

VBA

1Sub 画像複数挿入2000_2() 2Dim cntL As Integer, cntT As Integer 3Dim flgAspect As Boolean 4Dim SL As Single, SR As Single, ST As Single, SB As Single 5Dim ML As Single, MT As Single 6Dim xlApp As Object 7Dim dlgOpen As Variant 8Dim myPre As Presentation 9Dim Sld As Slide 10Dim n As Long 11Dim i As Integer, j As Integer 12Dim sldWidth As Single, sldHeight As Single 13Dim realWidth As Single, realHeight As Single 14Dim myWidth As Single, myHeight As Single 15Dim myLeft As Single, myTop As Single 16Dim myPic As Shape 17cntL = 2 '★横方向枚数2~6などで変更 18cntT = 1 '★縦方向枚数2~6などで変更 19flgAspect = True '★縦横比を固定するときはTrue,しないときはFalseで変更 20SL = 0 'スライド左余白 21SR = 0 'スライド右余白 22ST = 0 'スライド上余白 23SB = 0 'スライド下余白 24ML = 0 '左右間隔 25MT = 0 '上下間隔 26 27Set myPre = ActivePresentation 28With myPre 29sldHeight = .SlideMaster.Height 30sldWidth = .SlideMaster.Width 31End With 32realWidth = sldWidth - SL - SR 33realHeight = sldHeight - ST - SB 34myWidth = realWidth / cntL - ML 35myHeight = realHeight / cntT - MT 36Set xlApp = CreateObject("Excel.Application") 37dlgOpen = xlApp.GetOpenFileName("gif,*.gif,jpg,*.jpg,jpg,*.jpeg,bmp,*.bmp,png,*.png,wmf,*.wmf,tiff,*.tiff", , , , True) 38With myPre.Slides '新規スライド 39j = 1 40i = 1 41Set Sld = .Add(.Count + 1, ppLayoutBlank) 42End With 43If IsArray(dlgOpen) Then 44For n = LBound(dlgOpen) To UBound(dlgOpen) 45If i > cntT Then 'さらに新規スライド 46i = 1 47With myPre.Slides 48Set Sld = .Add(.Count + 1, ppLayoutBlank) 49End With 50End If 51myLeft = SL + (j - 1) * realWidth / cntL 52myTop = ST + (i - 1) * realHeight / cntT 53Set myPic = Sld.Shapes.AddPicture _ 54(FileName:=dlgOpen(n), _ 55LinkToFile:=msoFalse, _ 56SaveWithDocument:=msoTrue, _ 57Left:=myLeft, Top:=myTop) 58With myPic 59.LockAspectRatio = flgAspect 60.Height = myHeight 61If flgAspect = False Then 62.Width = myWidth 63Else 64If .Width > myWidth Then 65.Width = myWidth 66End If 67End If 68End With 69If j < cntL Then '横にずらす 70j = j + 1 71Else '改行 72j = 1 73i = i + 1 74End If 75Next n 76End If 77xlApp.Quit 78Set dlgOpen = Nothing 79Set xlApp = Nothing 80Set Sld = Nothing 81Set myPre = Nothing 82End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

nakit

2016/11/27 12:18

記載されているソースコードは、教えて!Gooでベストアンサーとなっているn_na_ttoさんが書かれているソースそのもののように見えます。xu0124さんがこれを元にどのように試行錯誤されたのか、またその際に何がわからないのかを記載したほうが回答がつきやすいと思います。
xu0124

2016/11/27 13:01

すみません。コードを書かないのでうまく伝わらないかもしれませんが①新規のスライドは作成しない。②既存の図形を削除してから、画像を挿入する。この2点を上記のコードから変更したいです
guest

回答1

0

自己解決

解凍し、画像部分を差し替える。

投稿2016/12/03 01:28

xu0124

総合スコア31

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問