|
A table in PowerPoint 97 was a Word Table inserted into a
PowerPoint slide. Hence manipulating the contents of the shape requires
knowledge of the MS Word object model. In this example, we shall insert a
Word object onto the slide and create a table within the Word document.
' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
'
--------------------------------------------------------------------------------
Option Explicit
Sub WordTableGen()
' I've used early binding in this
example so do remember
' to set a reference to the Word object
library.
Dim wdDoc As Word.Document
Dim wdRow As
Word.Row
Dim wdColumn As Word.Column
Dim wdCell As Word.Cell
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim pptPres As PowerPoint.Presentation
Set pptPres =
ActivePresentation
With pptPres
Set pptSlide =
.Slides.Add(.Slides.Count, ppLayoutBlank)
End With
With
pptSlide.Shapes
Set pptShape =
.AddOLEObject(Left:=120, Top:=110, Width:=480, Height:=320, _
ClassName:="Word.Document", Link:=msoFalse)
End With
Set wdDoc
= pptShape.OLEFormat.Object
wdDoc.Tables.Add Range:=wdDoc.Range(0,
0), NumRows:=2, NumColumns:=2
On Error Resume Next
wdDoc.Tables(1).Range.Font.Size = 36
For Each wdRow In
wdDoc.Tables(1).Rows
For Each wdCell In
wdRow.Cells
wdCell.Range.Text = "Sample text in Cell(" & _
wdCell.RowIndex & "," & wdCell.ColumnIndex & ")"
Next wdCell
Next wdRow
wdDoc.Close True
wdDoc.Application.Quit
Set wdDoc = Nothing
End Sub
|
|
PowerPoint 2000 introduced the new native PowerPoint
shape, which was more easily manipulated however in exchange we lost the
functionality that MS Word provided. The example below explains how to
insert a table shape, add rows, to add text in the cells, how to merge
cells and also how to easily manipulate an individual cell by treating
it as just as a PowerPoint shape.
'
--------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
'
--------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
'
--------------------------------------------------------------------------------
Sub NativeTable()
Dim pptSlide
As Slide
Dim pptShape As Shape
Dim pptPres As Presentation
Dim iRow As Integer
Dim iColumn As Integer
Dim oShapeInsideTable As
Shape
Set pptPres = ActivePresentation
With pptPres
Set pptSlide
= .Slides.Add(.Slides.Count, ppLayoutBlank)
End
With
With pptSlide.Shapes
Set pptShape = .AddTable(NumRows:=3, NumColumns:=5, Left:=30, _
Top:=110, Width:=660, Height:=320)
End With
With pptShape.Table
For
iRow = 1 To .Rows.Count
For iColumn = 1 To .Columns.Count
With .Cell(iRow, iColumn).Shape.TextFrame.TextRange
.Text = "Sample text in Cell"
With .Font
.Name = "Verdana"
.Size = "14"
End With
End With
Next iColumn
Next iRow
End With
'
You can treat the table as a grouped shape too. Note that the
' items within the table have indices in reverse order.
With pptShape.GroupItems.Range(Array(1, 2, 3))
With .Fill
.Visible = True
.BackColor.SchemeColor = ppFill
End With
With
.TextFrame.TextRange.Font
.Italic = True
.Color.RGB = RGB(125, 0, 125)
End With
End With
' Let's look at how
to merge cells in a native PowerPoint table
With pptShape.Table
' Insert a row at the top of the table
and set it's height
.Rows.Add BeforeRow:=1
.Rows(1).Height = 30
' Now merge all the cells of the Top row
.Cell(1, 1).Merge .Cell(1, 5)
' Tip: To manipulate properties of
individual cells in the table
' get a reference to the shape which represents the cell
' and then manipulate it just as any PowerPoint auto shape
' Now grab a reference of the shape
which represents the merged cell
Set oShapeInsideTable = .Cell(1, 1).Shape
With oShapeInsideTable
With .TextFrame.TextRange
.Text = "Table of contents"
.ParagraphFormat.Alignment = ppAlignCenter
With .Font
.Bold = True
.Size = 20
End With
End With
With .Fill
.Patterned (msoPatternDashedHorizontal)
.ForeColor.SchemeColor = ppShadow
.BackColor.RGB = RGB(213, 156, 87)
.Visible = True
End With
End With
End With
End Sub
|