VBA for Global PowerPoint Character Spacing Normalization

[dor1angray]

Hello fellow VBAers,

I am trying to come up with a solution to normalize all character spacing across all slides in a single PowerPoint document in one go. I have come up with a macros that do it for all shapes but it keeps skipping text in tables. However, when I add msoTable into the range it starts processing the slides but when it hits the first table it immediately returns a run-time error claiming that the specified value is out of range.:banghead:

Any idea what is wrong? Pretty sure it is a simple fix. Any help is truly appreciated.

Sub SpacingNormalization()

On Error GoTo ErrMsg
Dim shape As shape
slideCount = ActivePresentation.Slides.Count
For i = 1 To slideCount
With ActivePresentation.Slides(i)
.Select
For Each shape In ActivePresentation.Slides(i).Shapes
If shape.Type = msoPlaceholder Or shape.Type = msoTextBox Or shape.Type = msoAutoShape Or shape.Type = msoTable Then
shape.Select
ActiveWindow.Selection.ShapeRange.TextFrame2.TextRange.Font.Spacing = 0
End If
ErrMsg:
Next
End With
Next
MsgBox ("All segments have been normalized!")
End Sub

Thanks!

[John Wilson]

you cannot treat Tables like that you need to look at each cell separately

Try this (untested)


Sub SpacingNormalization()
On Error GoTo Errmsg
Dim oshp As shape
Dim otbl As Table
Dim iRow As Integer
Dim iCol As Integer
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Select Case oshp.HasTable
Case Is = True
Set otbl = oshp.Table
For iRow = 1 To otbl.Rows.Count
For iCol = 1 To otbl.Columns.Count
otbl.Cell(iRow, iCol).shape.TextFrame2.TextRange.Font.Spacing = 0
Next iCol
Next iRow
Case Is = False
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
oshp.TextFrame2.TextRange.Font.Spacing = 0
End If
End If
End Select
Next oshp
Next osld
MsgBox ("All segments have been normalized!")
Exit Sub
Errmsg:
MsgBox "Error " & Err.Description
End Sub

[dor1angray]

Worked like a charm, John! Thanks a bunch!! :ipray: