vba - VBA を使用して PPT テーブルにグラフィックを配置する

Question

VBA マクロを使用して、PPT テーブルのセルの中央にグラフィックを配置したいと考えています。このグラフィックは、ムービーを開始するためのボタンとして機能する必要があります。

テーブルの例

今、私は2つの質問があります:

1. グラフィックをセルに配置するにはどうすればよいですか
2. このような事前定義されたグラフィックスを使用するように PPT に指示するにはどうすればよいですか

または、セルをクリックしてアニメーションを開始するより良い方法はありますか。

Answer 1

Sub table_with_button()

  Dim PR As Presentation
  Dim FOL As Slide
  Dim xx, yy, dx, dy As Integer
  Dim Bild, tabelle As Shape
  Dim video As String

  Set PR = ActivePresentation
  Set FOL = PR.Slides.Add(PR.Slides.Count + 1, ppLayoutBlank)

  ' create table
  Set tabelle = FOL.Shapes.AddTable(NumRows:=2, NumColumns:=2, _
                        Left:=cm2Points(1), Top:=cm2Points(1), _
                        Width:=cm2Points(5), Height:=cm2Points(5))

  ' get position of table cell
  xx = tabelle.Table.Cell(2, 2).Shape.Left
  yy = tabelle.Table.Cell(2, 2).Shape.Top
  dx = tabelle.Table.Cell(2, 2).Shape.Width
  dy = tabelle.Table.Cell(2, 2).Shape.Height

  ' insert button
  Set Bild = FOL.Shapes.AddShape(msoShapeActionButtonForwardorNext, xx, yy, _
             dy * 0.5, dy * 0.5)

  ' move button to cell center
  Bild.Left = xx + (dx / 2) - (Bild.Width  / 2)
  Bild.Top  = yy + (dy / 2) - (Bild.Height / 2)

  ' insert hyperlink
  video = "c:\video.avi"
  Bild.AlternativeText = video
  Bild.ActionSettings(ppMouseClick).Hyperlink.Address = video

End Sub

Function cm2Points(inVal As Single)
  cm2Points = inVal * 28.346
End Function

Function Points2cm(ByVal inVal As Single)
  Points2cm = inVal / 28.346
End Function