I'm trying to create a text table with 2 columns,
add a vertical line shape between the columns,
each row with a different color line,
and make it so when you add text to the table the length of the line changes according to the row height.
This is what ChatGPT came up with:
Sub UpdateLineShapes()
Dim slide As slide
Dim tbl As Table
Dim shp As Shape
Dim rowNum As Integer
Dim lineColors(1 To 7) As Long
Dim lineWidth As Single
Dim lineHeight As Single
Dim lineTop As Single
Dim tableTop As Single
Dim rowHeight As Single
' Define the slide containing the table and line shapes
Set slide = ActivePresentation.Slides(1) ' Change slide index as needed
' Define the table containing the data
Set tbl = slide.Shapes("Table 1").Table ' Change the name of the table shape as needed
' Define the predetermined line colors
lineColors(1) = RGB(255, 0, 0) ' Red
lineColors(2) = RGB(0, 255, 0) ' Green
lineColors(3) = RGB(0, 0, 255) ' Blue
lineColors(4) = RGB(255, 255, 0) ' Yellow
lineColors(5) = RGB(255, 0, 255) ' Magenta
lineColors(6) = RGB(0, 255, 255) ' Cyan
lineColors(7) = RGB(128, 128, 128) ' Gray
' Get the top position of the table
tableTop = tbl.Top
' Loop through each row in the table
For rowNum = 1 To 7 ' Assuming there are 7 rows
' Define the line shape corresponding to the row
Set shp = slide.Shapes("Line" & rowNum) ' Assuming line shapes are named "Line1", "Line2", etc.
' Preset line width
lineWidth = 2 ' Fixed line width (Modify as needed)
' Calculate line height based on row height and subtract 0.4 cm
rowHeight = tbl.Rows(rowNum).Height - 0.4 * 28.35 ' Convert 0.4 cm to points (1 cm = 28.35 points)
' Calculate top position of the line shape to align it to the middle of the row
lineTop = tableTop + tbl.Rows(1).Top + (rowHeight / 2) + (rowHeight * (rowNum - 1))
' Update line properties
With shp.Line
' Assign predetermined line color
.ForeColor.RGB = lineColors(rowNum)
.Weight = lineWidth
' Adjust line length to match calculated height
shp.Height = rowHeight
' Set the top position to align the line to the middle of the row
shp.Top = lineTop
End With
Next rowNum
End Sub
VBA is not accepting the .Top
command.
I get a compile error:
Method or data member not found
and .Top
is highlighted in red in this line:
' Get the top position of the table
tableTop = tbl.Top
Try the Top method of the Shape object instead...
tableTop = tbl.Parent.Top
or
tableTop = slide.Shapes("Table 1").Top