Sub 批量设置字体和颜色()
On Error Resume Next
wd = Weekday(Date, 2)
wk = wd + 1
w = wk Mod 2 + 1
For j = 1 To ActivePresentation.Slides.Count
Set myDocument = ActivePresentation.Slides(j)
ss = j Mod wk + 1
st = j Mod wk + 2
zs1 = j Mod 8 + 1
zs2 = j Mod 9 + 1
zt = Choose(IIf(w = 1, zs1, zs2), "汉仪中楷简", "方正字迹-张颢硬笔楷书", "方正苏新诗柳楷简体", "方正魏碑简体", "华文隶书", "华文楷体", "汉仪南宫体简", "全新硬笔楷书简", "汉鼎简楷体", "楷体_GB2312", "华文行楷", "方正北魏楷书简体", "方正康体简体", "方正黄草简体", "汉仪细行楷简")
'zs = Choose(IIf(w = 1, zs1, zs2), vbBrown, vbGreen, vbGray, vbOrange, vbRed, vbPink, vbYellow, vbWhite, VbViolet, Thistle, Fuchsia, MediumPurple)
zh = Choose(IIf(w = 1, zs1, zs2), 38, 48, 56, 38, 40, 44, 44, 46, 48, 50, 54, 56, 58, 64, 72, 98, 130)
For Each s In myDocument.Shapes
If s.HasTextFrame Then
With s.TextFrame.TextRange.Font
.Size = zh
.Name = zt
.Bold = True
.Color.RGB = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
End With
End If
Next
Next
End Sub |
