Consulting

Results 1 to 2 of 2

Thread: Table row lines without column lines

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

    Table row lines without column lines

    Good evening

    I have the following code, from VBA Express you made, but I am unable to remove the vertical borders? I only wish to have horizontal borders - on rows / cells that are selected.
    Can you assist me please? Thank you.


    Sub TableLines()
    Dim tbl As Table
    Dim Icol As Integer
    Dim Irow As Integer
    On Error GoTo err
    Set tbl = ActiveWindow.Selection.ShapeRange(1).Table
    '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
    'hide existing borders
    For i = 1 To 6
    tbl.Cell(Irow, Icol).Borders(i).visible = msoFalse
    Next i
    For i = 1 To 4
    With tbl.Cell(Irow, Icol).Borders(i)
    .visible = msoTrue
    .ForeColor.RGB = RGB(180, 180, 180)
    .Weight = 1
    End With
    Next i
    End If
    Next Icol
    Next Irow
    Exit Sub ' usual exit
    err: 'error
    MsgBox "Please select table rows / cells and try again"
    End Sub

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Unfortunately this is a long standing bug in MSFT's code.

    You could try this but it may not work as expected.

    Sub TableLines()
    Dim tbl As Table
    Dim Icol As Integer
    Dim Irow As Integer
    Dim i As Integer
    On Error GoTo err
    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 = 1
    End With
    Next i
    End If
    Next Icol
    Next Irow
    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

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
  •