【PowerPointVBA】選択中shpの中身を同名shpに展開する

今作ってるxl→pp転記マクロの実行後に手直ししたいときに作ったやつ。

テキストボックスを選択中に実行すると、全スライドを巡回して同名のシェイプ名の中身にコピペしまくる。

転記のアンカーに使ってたシェイプ名をpp単体でもアンカーとして使いまわすだけなので楽。

' ==========================================
' ここから　pp選択中shpの中身を同名shpに展開する
' ==========================================
Sub pp選択中shpの中身を同名shpに展開する()
  Dim myShp名 As String, myStr As String
  myShp名 = Get選択中Shp名
  myStr = Get選択中Shpのテキスト
  
  Dim sld As PowerPoint.Slide
  Dim shp As PowerPoint.Shape
  
  For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
      If shp.Name = myShp名 Then
        shp.TextFrame.TextRange.Text = myStr
        Exit For
      End If
    Next
  Next

End Sub

Function Get選択中Shp名() As String
  With ActiveWindow.Selection
    If .Type >= ppSelectionShapes Then
      Get選択中Shp名 = .ShapeRange.Name
    End If
  End With
End Function

Function Get選択中Shpのテキスト() As String
  With ActiveWindow.Selection
    If .Type >= ppSelectionShapes Then
      Get選択中Shpのテキスト = .ShapeRange.TextFrame.TextRange.Text
    End If
  End With
End Function

' ==========================================
' ここまで　pp選択中shpの中身を同名shpに展開する
' ==========================================