ppt宏


Sub macro()
Set pages = ActivePresentation.Slides.Range
pageCount = pages.Count
'第一页和最后一页跳过
For i = 2 To pageCount - 1
Set pptSlide = ActiveWindow.Presentation.Slides(i)
For Each pptShape In pptSlide.Shapes
If pptShape.HasTextFrame Then
With pptShape.TextFrame2
.TextRange.Font.Spacing = 0
End With
End If
Next
Next
End Sub


PPT中可正常运行的代码:
Sub ChangeTextFont()
Set pages = ActivePresentation.Slides.Range
pageCount = pages.Count
'第一页和最后一页跳过
For i = 2 To pageCount - 1
DoEvents

Set pptSlide = ActiveWindow.Presentation.Slides(i)
For Each pptShape In pptSlide.Shapes
If pptShape.HasTextFrame Then
With pptShape.TextFrame2
.TextRange.Font.Spacing = 10
End With
End If
Next



ActiveWindow.View.GotoSlide Index:=i
shapeCount = ActiveWindow.Selection.SlideRange.Shapes.Count
For j = 1 To shapeCount
ActiveWindow.Selection.SlideRange.Shapes(j).Select
shapeType = ActiveWindow.Selection.SlideRange.Shapes(j).Type
'1 - 自选图形
'7 - 公式
'13 - 图片
'14 - 占位符
'15 - 艺术字
'17 - 文本框
'19 - 表格
'Debug.Print shapeType
Select Case shapeType
Case 1, 14, 17
Set txtRange = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange
txtRange.Select
If txtRange.Text <> "" Then
'设置字体为楷体, 24号
With txtRange.Font
.Name = "楷体"
.Size = 24
.Bold = True   '设置字体加粗
.Italic = True   ‘设置字体斜体


End With
'设置段落格式为1.1倍行距
With txtRange.ParagraphFormat
.SpaceWithin = 1.1
End With
End If
Case 7, 13, 15
Case 19
End Select
Next j
Next i
End Sub








只能在Word中运行的代码:
Sub SpacingUp()
With Selection.Font
.Spacing = .Spacing + 0.1   '设置字体间距

End With
End Sub
Sub SpacingDown()
With Selection.Font
.Spacing = .Spacing - 0.1  '设置字体间距

End With
End Sub

.Bold = True   '设置字体加粗
.Italic = True   '设置字体斜体




With oTxtRange.ParagraphFormat
              .SpaceWithin = 1              '设置行距
              .SpaceBefore = 0              '设置段前间距
              .SpaceAfter = 0               ‘设置段后间距
              
              
              
              
              With oTxtRange.Font
              .NameFarEast = "微软雅黑"     '设置中文字体
              .Name = "Calibri"             '设置英文字体
              .Size = 16                    '设置字体大小
              .Color.RGB = RGB(Red:=0, Green:=0, Blue:=0) ‘设置字体颜色







Loading Disqus comments...
Table of Contents