Consulting

Results 1 to 4 of 4

Thread: Formats Table Your Cursor Is In

  1. #1
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location

    Red face Formats Table Your Cursor Is In

    Hi John, wonderful site btw. Helped me tonnes last year.

    I have code, which formats a table - it works with a cursor in a cell or if the table's selected - which is great to have both options.

    However, if I have two or more tables on one slide, it always goes to one of the tables, and ignores other tables. I've spent days trying to fix this.

    I want it to format the selected table (selected, and if the cursor is put in a cell of that table)?

    I've attached a PowerPoint slide as an example with 4 tables. This code affects one table - regardless if it's for another table on that slide. I'm sure readers will find this code useful too.

    My code is:

    Public Sub FormatTable()
     
    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
     
    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)
    .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.VerticalAnchor = msoAnchorTop
    .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Select Case y
    Case Is = 1
    .Shape.TextFrame2.MarginLeft = 0
    .Shape.TextFrame2.MarginRight = 0
    .Shape.TextFrame2.TextRange.Font.Bold = msoTrue
    .Shape.TextFrame2.VerticalAnchor = msoAnchorTop
    Case Is = 2
    .Shape.TextFrame2.MarginLeft = 5
    .Shape.TextFrame2.MarginRight = 5
    .Shape.TextFrame2.TextRange.Font.Bold = msoTrue
    .Shape.TextFrame2.VerticalAnchor = msoAnchorBottom
    Case Else
    .Shape.TextFrame2.MarginLeft = 5
    .Shape.TextFrame2.MarginRight = 5
    .Shape.TextFrame2.TextRange.Font.Bold = msoFalse
    .Shape.TextFrame2.VerticalAnchor = msoAnchorTop
    End Select
    End With
    Next 'y
    Next 'x
     
    With ActiveWindow.Selection.ShapeRange(1).Table
        With .Cell(1, 1).Shape
            With .TextFrame2.TextRange
     
            End With
    End With
    End With
    With ActiveWindow.Selection.ShapeRange(1).Table
        With .Cell(2, 1).Shape
            With .TextFrame2.TextRange
     
            End With
    End With
    End With
     
    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 = 1
    tbl.Cell(Mini, y).Borders(ppBorderTop).DashStyle = msoLineSolid
    tbl.Cell(Maxi, y).Borders(ppBorderBottom).ForeColor.RGB = RGB(118, 118, 118)
    tbl.Cell(Maxi, y).Borders(ppBorderBottom).Weight = 1
    tbl.Cell(Maxi, y).Borders(ppBorderBottom).DashStyle = msoLineSolid
    tbl.Cell(1, y).Borders(ppBorderBottom).ForeColor.RGB = RGB(118, 118, 118)
    tbl.Cell(1, y).Borders(ppBorderBottom).Weight = 1
    tbl.Cell(1, y).Borders(ppBorderBottom).DashStyle = msoLineSolid
    tbl.Cell(2, y).Borders(ppBorderBottom).ForeColor.RGB = RGB(118, 118, 118)
    tbl.Cell(2, y).Borders(ppBorderBottom).Weight = 1
    tbl.Cell(2, y).Borders(ppBorderBottom).DashStyle = msoLineSolid
    Next
     
    End If
    Exit Sub ' usual exit
    err: 'error
    MsgBox "Please place your cursor in a table cell or select a table"
     
    End Sub
    Thank you.
    Attached Files Attached Files
    Last edited by Paul_Hossler; 03-09-2020 at 06:30 AM. Reason: REplaced HTML tqgs with CODE tags

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    I would suggest DELETE this bit

    Dim shp As Shape
    For Each shp In ActiveWindow.Selection.SlideRange.Shapes
    With shp
    If .HasTable Then .Select
    End With
    Next shp

    Then it will only format the selected table.

    If you want to format ALL tables you will need to say so and take a different approach
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I have code, which formats a table - it works with a cursor in a cell or if the table's selected - which is great to have both options.

    However, if I have two or more tables on one slide, it always goes to one of the tables, and ignores other tables. I've spent days trying to fix this.

    I want it to format the selected table (selected, and if the cursor is put in a cell of that table)?


    Question: Pseudo-Code (based on it always goes to one of the tables, and ignores other tables.)

    If 1 table on slide, then

    If table selected or cursor in cell, then

    Reformat

    Else

    Error message

    Endif

    ElseIf 2 tables on slide, then

    If a table is selected or cursor in cell, then

    Reformat just that table

    Else

    Error message

    Endif
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    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) / 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

  4. #4
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    Thanks guys, brilliant work, so grateful. Thanks!

Posting Permissions

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