1

我一直在尝试开发一个宏,它将用“Arial”替换演示文稿中的所有字体。到目前为止,我已经成功地替换了文本框、表格和 SmartArt 的字体,但无法替换分组对象中的字体。以下是供参考的代码。有人可以帮忙吗?

子文本字体()

Dim oSl As Slide
Dim oSh As Shape
Dim oTbl As Table
Dim oSmt As SmartArt
Dim oNode As SmartArtNode

Dim lRow As Long
Dim lCol As Long
Dim sFontName As String

sFontName = "Arial"

With ActivePresentation
    For Each oSl In .Slides
        For Each oSh In oSl.Shapes
            With oSh
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = sFontName
                    End If
                End If
            End With
        Next
    Next
End With

For Each oSh In oSl.Shapes
    If oSh.HasTable Then
        Set oTbl = oSh.Table
        For lRow = 1 To oTbl.Rows.Count
            For lCol = 1 To oTbl.Columns.Count
                With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                    .Font.Name = "Arial"
                End With
            Next
        Next
    ElseIf oSh.HasSmartArt Then
        For Each oNode In oSh.SmartArt.AllNodes
            oNode.TextFrame2.TextRange.Font.Name = "Arial"
        Next
    End If
Next

Next osl End Sub

4

2 回答 2

0

假设 oshp 是分组对象(您可以轻松地遍历所有形状并测试它是否是分组形状如果 oshp.type = msoGroup then .... 那么您可以通过

 Dim li As Long
    Dim oshp As Shape

    Set oshp = powerpoint.shape

If oshp.type = msoGroup then

          For li = 1 To oshp.GroupItems.count
            ' you can add some code here for finding a particular shape based on certain properties 
             oshp.GroupItems(li).Select
             if oshp.type=rectangle etc etc
          Next

您上面提到的代码保持不变。这只是一个模糊的解释,但你会明白的

于 2017-04-19T18:43:20.480 回答
0

用选定的单一字体替换整个演示文稿的代码:

Sub TextFonts()

 Dim oSl As Slide
 Dim oSh As Shape
 Dim oTbl As Table
 Dim oSmt As SmartArt
 Dim oNode As SmartArtNode

 Dim lRow As Long
 Dim lCol As Long
 Dim X As Long
 Dim sFontName As String

 sFontName = "Arial"


 'Text Boxes
 With ActivePresentation
     For Each oSl In .Slides
         For Each oSh In oSl.Shapes
             With oSh
                 If .HasTextFrame Then
                     If .TextFrame.HasText Then
                         .TextFrame.TextRange.Font.Name = sFontName
                     End If
                 End If
             End With
         Next
     Next
 End With

 'Grouped Objects
 For Each oSl In ActivePresentation.Slides
     For Each oSh In oSl.Shapes
         With oSh
             Select Case .Type
             Case Is = msoGroup
                 For X = 1 To .GroupItems.Count
                     If .GroupItems(X).HasTextFrame Then
                         If .GroupItems(X).TextFrame.HasText Then
                              .GroupItems(X).TextFrame.TextRange.Font.Name = sFontName
                         End If
                     End If
                 Next X
             End Select
         End With ' oSh
     Next oSh
 Next oSl

 'Smart Arts
 For Each oSl In ActivePresentation.Slides
     For Each oSh In oSl.Shapes
         If oSh.HasTable Then
             Set oTbl = oSh.Table
             For lRow = 1 To oTbl.Rows.Count
                 For lCol = 1 To oTbl.Columns.Count
                     With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                         .Font.Name = sFontName
                     End With
                 Next
             Next
         ElseIf oSh.HasSmartArt Then
             For Each oNode In oSh.SmartArt.AllNodes
                 oNode.TextFrame2.TextRange.Font.Name = sFontName
             Next
         End If
     Next
 Next oSl

End Sub
于 2017-05-29T11:35:26.100 回答