Search code examples
vbapowerpointdata-linking

Link shape size and position to a text table dynamic content


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

Solution

  • Try the Top method of the Shape object instead...

    tableTop = tbl.Parent.Top
    

    or

    tableTop = slide.Shapes("Table 1").Top