PDA

View Full Version : [SOLVED:] Formats Table Your Cursor Is In



RayKay
03-07-2020, 08:33 AM
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.

John Wilson
03-09-2020, 05:08 AM
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

Paul_Hossler
03-09-2020, 06:35 AM
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

RayKay
03-09-2020, 03:57 PM
Thanks guys, brilliant work, so grateful. Thanks!