Consulting

Results 1 to 4 of 4

Thread: Format a specific table ignoring other tables on that slide

  1. #1
    VBAX Regular
    Joined
    Dec 2018
    Posts
    69
    Location

    Format a specific table ignoring other tables on that slide

    Hi John

    Hope you're well. Your skills and website have been astronomical in helping me and I'm sure visitors.

    I have one thing I can't fix myself. The below code works well on any table in PowerPoint, however, if there are TWO or more tables on a slide, it only affects the same one table. It's set to work if a table is selected, or the mouse is in a table cell.

    If I have 2 tables, A & B, and it works on A, when I go to use it on table B, it affects table A - and B is ignored. Thank you


    Code:

    Public Sub ConvertTable()
    
    
    Dim tbl As Table
    Dim iCol As Integer
    Dim iRow As Integer
    Dim I As Integer
    On Error GoTo err
    
    
    Dim shp As Shape
    For Each shp In ActiveWindow.Selection.SlideRange.Shapes
    With shp
    If .HasTable Then .Select
    End With
    Next shp
    
    
    With ActiveWindow.Selection.ShapeRange(1).table
        With .Cell(1, 1).Shape
            With .TextFrame2.TextRange
                .Text = "Use Cell Head tool"
            End With
        End With
    End With
    
    
    Dim X As Integer
    Dim Y As Integer
    Dim otbl As Table
    Dim B As Long
    On Error GoTo err:
    Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
    otbl.Parent.Height = 0
    For X = 1 To otbl.Columns.Count
    For Y = 1 To otbl.Rows.Count
    With otbl.Cell(Y, X)
    If .Selected Then
    .Shape.TextFrame2.MarginLeft = 0
    .Shape.TextFrame2.MarginRight = 0
    .Shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    .Shape.TextFrame2.TextRange.Font.Size = 12
    .Shape.TextFrame2.TextRange.Font.Name = "Arial"
    .Shape.TextFrame2.TextRange.Font.Bold = msoFalse
    .Shape.TextFrame2.VerticalAnchor = msoAnchorTop
    .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    End With
    Next 'y
    Next 'x
    
    
    Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
    ' hide selected borders
    Call CommandBars.ExecuteMso("BorderNone")
    DoEvents
    'exit if no selected table
    If err.Number <> 0 Then Exit Sub
    For iRow = 1 To tbl.Rows.Count
    For iCol = 1 To tbl.Columns.Count
    If tbl.Cell(iRow, iCol).Selected Then
    For I = 1 To 3 Step 2
    With tbl.Cell(iRow, iCol).Borders(I)
    .visible = msoTrue
    .ForeColor.RGB = RGB(180, 180, 180)
    .Weight = 0.75
    End With
    Next I
    End If
    Next iCol
    Next iRow
    
    
    Dim Mini As Integer
    Dim Maxi As Integer
    Dim Minj As Integer
    Dim Maxj As Integer
    Dim iflag As Boolean
    Dim jflag As Boolean
    Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
    For I = 1 To tbl.Rows.Count
    For J = 1 To tbl.Columns.Count
    If tbl.Cell(I, J).Selected Then
    If iflag = False Then
    Mini = I
    Maxi = I
    iflag = True
    Else
    Maxi = I
    End If
    If jflag = False Then
    Minj = J
    Maxj = J
    jflag = True
    Else
    Maxj = J
    End If
    End If
    Next
    Next
    If Mini > 0 Then
    
    
    For Y = Minj To Maxj
    tbl.Cell(Mini, Y).Borders(ppBorderTop).ForeColor.RGB = RGB(255, 255, 255)
    tbl.Cell(Mini, Y).Borders(ppBorderTop).Weight = 3
    tbl.Cell(Mini, Y).Borders(ppBorderTop).DashStyle = msoLineSolid
    tbl.Cell(Maxi, Y).Borders(ppBorderBottom).ForeColor.RGB = RGB(255, 255, 255)
    tbl.Cell(Maxi, Y).Borders(ppBorderBottom).Weight = 0
    tbl.Cell(Maxi, Y).Borders(ppBorderBottom).DashStyle = msoLineSolid
    Next
    
    
    End If
    Exit Sub ' usual exit
    err: 'error
    MsgBox "Please select table rows / cells and try again"
    End Sub
    Last edited by Paul_Hossler; 02-28-2019 at 09:07 AM.

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,806
    Location
    Sorry I don't have time to wade through your code but here is the general layout

    Public Sub ConvertTable()
    Dim tbl As Table
    Dim iCol As Integer
    Dim iRow As Integer
    Dim I As Integer
    Dim J As Integer
    On Error GoTo err
    Dim oshp As Shape
    For Each oshp In ActiveWindow.Selection.ShapeRange
    If oshp.HasTable Then
    Set tbl = oshp.Table
    With tbl
    
    
    ' put all the code affecting tbl here
    
    
    End With
    
    
    End If ' it's a table
    Next oshp
    Exit Sub ' usual exit
    err: 'error
    MsgBox "Please select table rows / cells and try again"
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Dec 2018
    Posts
    69
    Location
    Great, thank you

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,436
    Location
    You can use the[#] icon to put CODE tags around your macro to format and to set it off
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •