Question

我正在努力想出一个解决方案，一次性对单个PowerPoint文档中所有幻灯片的所有字符间距进行规范化。我已经提出了一个宏，它可以为所有形状执行此操作，但它一直在跳过表格中的文本。但是，当我将msoTable添加到范围时，它开始处理幻灯片，但是当它到达第一个表时，它会立即返回一个运行时错误，声称指定的值超出范围。

知道出了什么问题吗？很确定这是一个简单的修复。

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

真的很感激任何帮助。提前谢谢！

Answer 1

PPT自动化的第一条规则：除非绝对必要，否则永远不要选择任何东西。 PPT自动化的第二条规则：你几乎不需要。

相应地修改了您的代码。

在大多数情况下，您必须逐个单元格逐步查看表格以修改任何内容。更多mods。见下文：

Sub SpacingNormalization()
On Error GoTo ErrMsg 
' It's unwise to use PPT keywords as variable names:
' Dim shape As shape
Dim oSh as Shape
Dim oSl as Slide

For each oSl in ActivePresentation.Slides
For Each oSh In oSl.Shapes

If oSh.Type = msoPlaceholder Or oSh.Type = msoTextBox Or oSh.Type = msoAutoShape Then

oSh.TextFrame2.TextRange.Font.Spacing = 0

Else 
If  oSh.Type = msoTable then
  Call ProcessTable(oSh.Table)
end if  ' Table
End If  ' Other types
Next ' oSh
Next ' oSl


NormalExit:
MsgBox ("All segments have been normalized!")
Exit Sub
ErrMsg:
Resume Next

End Sub

Sub ProcessTable(oTbl As Table)

    Dim Col As Long
    Dim Row As Long

    With oTbl
        For Col = 1 To .Columns.Count
            For Row = 1 To .Rows.Count
                .Cell(Row, Col).Shape.TextFrame2.TextRange.Font.Spacing = 0
            Next
        Next
    End With

End Sub

Answer 2

这是我提出的那个。它只在一个子范围内，似乎更简单一点：

Sub SpacingNormalization()
        On Error GoTo Errmsg
        Dim oshp As shape
        Dim otbl As Table
        Dim Rws As Integer
        Dim Clms 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 Rws = 1 To otbl.Rows.Count
                        For Clms = 1 To otbl.Columns.Count
                            otbl.Cell(Rws, Clms).shape.TextFrame2.TextRange.Font.Spacing = 0
                        Next Clms
                    Next Rws
                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"
    End Sub

全局PowerPoint字符间距规范化的VBA

2 个答案: