Format a specific table ignoring other tables on that slide

[RayKay]

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. :think: 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

[John Wilson]

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

[RayKay]

Great, thank you :)

[Paul_Hossler]

You can use the[#] icon to put CODE tags around your macro to format and to set it off