###前提・実現したいこと
画像差し替えマクロの作成
画像複数挿入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
回答1件
あなたの回答
tips
プレビュー