PowerPoint (全般)

PowerPoint 全般に関する話題を扱うフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8.1 : PowerPoint 2013)
写真挿入マクロを教えてください
投稿日時: 18/07/01 10:50:09
投稿者: よぴ

写真を挿入する事が多いパワーポイントなので、
挿入ボタンからではなく、マクロを実行したらすぐ写真選択画面にて選べるように
マクロを作成しました。
 
ただ、本当にやりたいのは
まず長方形のオートシェイブ8.81cm×6.61cm(4:3)を表示して
その中に選んだ写真がすっぽり入るようにしたいのです。
 
以下のマクロをどう修正すればよいでしょうか。
どうぞよろしくお願いします。
 
--------------
Option Explicit
 
Sub 写真挿入マクロ()
    Dim FD As FileDialog
    Dim SelectedFile As Variant
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
     
    Set FD = Application.FileDialog(msoFileDialogOpen)
    With FD
        With .Filters
            .Clear
            .Add "Images", "*.jpg;*.png;*.jpeg", 1
        End With
        .InitialFileName = ActivePresentation.Path & "\"
        If .Show = True Then
            Set SelectedFile = .SelectedItems
        End If
    End With
Dim NewPic As Shape
    Set NewPic = TSlide.Shapes.AddPicture(SelectedFile(1), msoFalse, msoTrue, 0, 0)
    NewPic.Name = "図"
End Sub

回答
投稿日時: 18/07/02 08:52:06
投稿者: んなっと

長方形に重ねるのではなく、長方形の塗りつぶし画像とするのがいいと思います。
 
Sub test()
  Dim dlgOpen As FileDialog
  Dim picName As String
  Dim Sld As Slide
  Dim Shp As Shape
  Set dlgOpen = Application.FileDialog(Type:=msoFileDialogOpen)
  With dlgOpen
    .Filters.Add "イメージ", "*.tiff; *.bmp; *.png; *.gif; *.jpg; *.jpeg; *.wmf", 1
    If .Show <> -1 Then Exit Sub
    picName = .SelectedItems(1)
  End With
  Set Sld = ActiveWindow.Selection.SlideRange(1)
  Set Shp = Sld.Shapes.AddShape(msoShapeRoundedRectangle, 10, 10, 8.81 * 28.346, 6.61 * 28.346)
  With Shp
    .Fill.Transparency = 0#
    .Fill.Visible = msoTrue
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.BackColor.SchemeColor = ppBackground
    .Fill.UserPicture picName
  End With
  With Sld.Shapes.Range(Shp.Name)
    .Distribute msoDistributeHorizontally, True
    .Distribute msoDistributeVertically, True
  End With

投稿日時: 18/07/03 05:10:21
投稿者: よぴ

んなっとさま
 
素晴らしいコードをありがとうございました
完璧にできました!感謝しかないです :o