CODEWITHSUNDEEP
vbapowerpoint
user2944647
user2944647

Reputation: 211

Place a graphic in a PPT table using VBA

I would like to place a graphic in the center of a cell of a PPT table using a VBA macro. This graphic should act as button for starting a movie.

Example of table

Now I have 2 questions:

  1. How can I place the graphics in a cell
  2. How do I tell PPT to use such a predefined graphics

Or are there better ways to start an animation by clicking on a cell.

Upvotes: 0

Views: 1368

Answers (1)

user2944647
user2944647

Reputation: 211

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

Upvotes: 1

Related Questions