macro support

[sksanjeev786]

Hi Team, The macro is working correctly for me but the colunm numbers are not coming there are 8 colum but i am getting 4 colunm

as i am inserting hte colunm after "Is great for weekend trips"

acr

[CODE=vba]
Sub InsertExactRowAfterWeekendTrips()
    Dim slide As slide
    Dim shape As shape
    Dim tbl As Table
    Dim totalCols As Integer
    Dim totalRows As Integer
    Dim rowIndex As Integer
    Dim found As Boolean
    Dim colIndex As Integer
    
    ' Get the active slide
    Set slide = ActivePresentation.Slides(Application.ActiveWindow.View.slide.slideIndex)
    
    ' Check if a shape is selected
    If Application.ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Please select a table.", vbExclamation, "No Table Selected"
        Exit Sub
    End If
    
    ' Get the selected shape
    Set shape = Application.ActiveWindow.Selection.ShapeRange(1)
    
    ' Check if the shape contains a table
    If Not shape.HasTable Then
        MsgBox "Selected shape is not a table.", vbExclamation, "Error"
        Exit Sub
    End If
    
    ' Get the table object
    Set tbl = shape.Table
    totalCols = tbl.Columns.Count
    totalRows = tbl.Rows.Count
    found = False
    
    ' Loop through rows to find the text "Is great for weekend trips"
    For rowIndex = 1 To totalRows
        If tbl.cell(rowIndex, 1).shape.TextFrame.TextRange.Text = "Is great for weekend trips" Then
            found = True
            Exit For
        End If
    Next rowIndex
    
    ' If text is found, insert a new row after it and copy formatting
    If found Then
        tbl.Rows.Add (rowIndex + 1) ' Insert new row after the found row
        
        ' Copy text, formatting, font color, and background color
        For colIndex = 1 To totalCols
            With tbl.cell(rowIndex + 1, colIndex).shape.TextFrame.TextRange
                .Text = tbl.cell(rowIndex, colIndex).shape.TextFrame.TextRange.Text
                .Font.Size = tbl.cell(rowIndex, colIndex).shape.TextFrame.TextRange.Font.Size
                .Font.Bold = tbl.cell(rowIndex, colIndex).shape.TextFrame.TextRange.Font.Bold
                .Font.Italic = tbl.cell(rowIndex, colIndex).shape.TextFrame.TextRange.Font.Italic
                .Font.Color = tbl.cell(rowIndex, colIndex).shape.TextFrame.TextRange.Font.Color
            End With
            
            ' Copy cell background color
            tbl.cell(rowIndex + 1, colIndex).shape.Fill.ForeColor.RGB = tbl.cell(rowIndex, colIndex).shape.Fill.ForeColor.RGB
        Next colIndex
        
        MsgBox "Row duplicated successfully with exact format!", vbInformation, "Success"
    Else
        MsgBox "Text 'Is great for weekend trips' not found in the table.", vbExclamation, "Error"
    End If
End Sub

[/CODE]

 

[Sam_D_Ben]

I guess, after adding the new row, do the recalculation for column count.

totalCols = tbl.Columns.Count

 

[sksanjeev786]

I guess, after adding the new row, do the recalculation for column count.

totalCols = tbl.Columns.Count

Hi Sam,

Could you please share us macro as still i am getting the error..