|
|
'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
复制代码 |
|
