使用 VBA 为整个演示文稿设置相同的字体类型

Question

我想在每张幻灯片中通过运行使用 VBA。问题是，它无法更改 'chart'、'flow chart diagram' 中存在的字体，其中它有像矩形、圆角矩形 etc.How 这样的框也可以操作该文本？请帮忙！

如图矩形气候字体没有变化Different font type in rectangle

Answer 1

如果您利用 PowerPoint 中已经内置的功能，则根本不需要任何代码。字体主题是为处理这些情况而构建的。使用在名称中包含 (body) 或 (headings) 标签的字体选项格式化所有文本。然后，当您将字体主题从 Arial 切换到 Calibri 时，所有文本（包括图表和 SmartArt）都将更新。

对于已经使用本地格式而不是使用字体主题的演示文稿，将文件解压缩到 XML 并使用一个好的文本编辑器的查找和替换功能，您可以快速替换所有实例无需编程的字体。查找 'typeface="Arial"' 替换 'typeface="Calibri"' 然后重新压缩文件并恢复文件结尾。

Answer 2

这个问题的解决方案非常乏味，因为需要考虑许多不同类型的形状和文本范围。我无法 post 我的整个解决方案，因为我没有知识分子属性，但这应该会让你走上正轨：

Sub MakeFontsThemeFonts()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oShp2 As Shape
    Dim oTxtRange As TextRange

    ' Set majorFont and minorFont to Calibri
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Calibri"
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Calibri"        

    For Each oSld in ActivePresentation.Slides
        For Each oShp in oSld.Shapes
           If oShp.HasChart Then
               ' Call your chart handler
           ElseIf oShp.HasTable Then
               ' Call your table handler
           ElseIf oShp.HasSmartArt Then
               ' Call your SmartArt handler
           ElseIf oShp.HasTextFrame Then
               If oShp.HasText Then
                   Set oTxtRange = oShp.TextFrame.TextRange
                   Call RefontTextRange (oTxtRange)
               End If
           ElseIf oShp.Type = msoGroup Then
               For Each oShp2 in oShp.GroupItems
                    If oShp2.Type = ... Then
                         ' And so on, you wind up having to check for 
                         ' everything that's grouped all over again
                    End If
               Next
           End If
       Next
    Next
End Sub

Sub RefontTextRange (oTxtRange As TextRange)
   With oTxtRange.Font
       ' Sets the textrange to the body font.  If you want to make some stuff the heading font and some stuff the body font, you need to do more checking before sending here
       .Name = "+mn-lt"
   End With
End Sub

这就是解决方案的开始，但由于一些原因这会让人抓狂。对于表格，您必须单独解析每个单元格的 TextRange 并将这些 TextRanges 传递给您的 Refont 子。对于图表，您可能必须在设置 TextRange 和重新设置字体之前检查每个可以想象到的图表元素（我的情况比仅仅将字体设置为主题字体更复杂，而且我在尝试格式化 ChartArea 时没有成功一次）。

图表中的 "floating" 个形状有问题吗？当您说 "flow chart," 时，它是嵌入式 Visio 图表还是本机 SmartArt？有很多方法可以给这只猫蒙皮，但解决方案需要您识别可以使用 VBA.

访问的每种可能的文本容器类型

这里还有一个提示，可以帮助您了解图表中的浮动形状：

oShp.Chart.Shapes(1).TextFrame.TextRange.Font.Name = "+mn-lt"

但是当然首先你需要确保你有一个图表，里面有形状，这些形状有一个文本框...

Answer 3

看来您只需要更改母版幻灯片（包括notesmaster、slidemaster），而不用在每张幻灯片上工作。这是我的代码

Sub ChangeFont()
    ' 
    ' affect SmartArt font
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Garamond"
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Garamond"

    For i = 1 To Application.ActivePresentation.NotesMaster.Shapes.Count
        With Application.ActivePresentation.NotesMaster.Shapes(i).TextFrame.TextRange.Font
            .Name = "Garamond"
             If Application.ActivePresentation.NotesMaster.Shapes(i).Name Like "Notes*" Then
                .Bold = msoFalse
                .Size = 16
             End If
        End With
    Next i
    
    ' http://skp.mvps.org/2007/ppt003.htm
    ' Each design contained a slide master and possibly a title master. Several designs could be stored within a presentation.
    ' The slide master can contain several custom layouts which can be fully customized. 
    For Each oDesign In ActivePresentation.Designs
        ' slide master
        Set sm = oDesign.SlideMaster
        For j = 1 To sm.Shapes.Count
            If sm.Shapes(j).HasTextFrame Then
            With sm.Shapes(j).TextFrame.TextRange.Font
            .Name = "Garamond"
            End With
            End If
        Next j

        ' custom layouts
        lngLayoutCount = oDesign.SlideMaster.CustomLayouts.Count
        For I = 1 To lngLayoutCount
            Set oCL = oDesign.SlideMaster.CustomLayouts(I)
            For j = 1 To oCL.Shapes.Count
                If oCL.Shapes(j).HasTextFrame Then
                With oCL.Shapes(j).TextFrame.TextRange.Font
                .Name = "Garamond"
                End With
                End If
            Next j
        Next I
    Next
End Sub

使用 VBA 为整个演示文稿设置相同的字体类型

Setting same font type to whole presentation using VBA

powerpoint

vba