1 Attachment(s)
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:
Code:
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.
