vba - 使用 VBA 在 PPT 表格中放置图形

Question

我想使用 VBA 宏在 PPT 表格的单元格中心放置一个图形。该图形应作为开始电影的按钮。

表格示例

现在我有两个问题：

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