找回密码
 立即注册
搜索

PPT 修改 标题文本框字体 VBA 批处理

1
回复
722
查看
[复制链接]

2

主题

10

帖子

74

幻币

一流武者

Rank: 3Rank: 3

积分
312
QQ
2018-12-8 02:35:23 显示全部楼层 |阅读模式

    'log:
    'vba makes your daily work efficiently and effectively
    'created date: 2018-05-18
    'website for reference:
    'http://club.excelhome.net/forum.php?mod=viewthread&tid=938911&extra=
    'http://blog.sina.com.cn/s/blog_4928aeee0101bjvd.html
    'codes help you to change the fonts in a batch mode with VBA

    'ajust all fonts in PPT

    Sub font1()
    Dim mySlide As Slide
    Dim myShape As Shape
    Dim myRng As TextRange
    With ActivePresentation
    For Each mySlide In .Slides
    For Each myShape In mySlide.Shapes
    If myShape.HasTextFrame Then
    Set myRng = myShape.TextFrame.TextRange
    myRng.font.Name = "Arial" 'change font
    'myRng.font.Color.RGB = RGB(0, 0, 255)
    End If
    Next
    Next
    End With
    End Sub

    'ajust the font in first textbox for all slides
    Sub font2()
    On Error Resume Next
    Dim oPres As Presentation
    Set oPres = Application.ActivePresentation
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim tr As TextRange
    Dim sText As String
    Dim i As Long, j As Long
    Dim fjd As Integer

    For i = 1 To oPres.Slides.Count 'each slide
    Set oSlide = oPres.Slides.Item(i)

    fjd = oSlide.Shapes.Count

    For j = 1 To 1 'first item as title

    Set oShape = oSlide.Shapes.Item(j)

    If oShape.TextFrame.HasText = msoTrue Then
    Set tr = oShape.TextFrame.TextRange
    tr.font.NameAscii = "Arial" 'change font
    tr.font.NameFarEast = "Arial"
    tr.font.Size = 50
    'tr.font.Color.RGB = RGB(Red:=255, Green:=192, Blue:=0)

    Set tr = Nothing
    End If
    Set oShape = Nothing
    Next j

    Next i
    Set oPres = Nothing
    End Sub

复制代码
PPT学习论坛
回复

使用道具 举报

3

主题

8

帖子

71

幻币

江湖少侠

Rank: 2

积分
175
QQ
2018-12-8 05:53:43 显示全部楼层
参考附件 测试文件
test of font change.zip (29.51 KB, 下载次数: 14)
PPT学习论坛
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册