vba便捷使用 -- 修改没有母版的 ppt

vba便捷使用 – 修改没有母版的 ppt

wps 的 vb 编辑器折腾了好久不能用，下载vb for wps 也不可以，换成 ms office 一下解决。 alt+ f11 一键操作打开 vb编辑器。

内容借鉴知乎

1.office 批量删除PPT同一位置内容

要选中要删除的位置哦

Sub delete()

Dim oSlide As Slide, oShape As Shape
Dim myWidth As Single, myHeight As Single, myTop As Single, myLeft As Single

On Error Resume Next
If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
If Err.Number <> 0 Then
MsgBox "none" & vbCrLf & "choose one", vbExclamation + vbOKOnly
Err.Clear
Exit Sub
End If
MsgBox "choose exceed 1" & vbCrLf & "choose one", vbExclamation + vbOKOnly
Exit Sub
End If

Set oShape = ActiveWindow.Selection.ShapeRange(1)
myTop = oShape.Top
myLeft = oShape.Left
myHeight = oShape.Height
myWidth = oShape.Width

For Each oSlide In ActivePresentation.Slides
For Each oShape In oSlide.Shapes
If Abs(myTop - oShape.Top) < 1 And Abs(myLeft - oShape.Left) < 1 And Abs(myHeight - oShape.Height) < 1 And Abs(myWidth - oShape.Width) < 1 Then
oShape.delete
End If
Next
Next
End Sub

2.调整整个ppt 的字体和格式

Sub 批量调整字体格式()
    Dim sp As Shape
    Dim sld As Slide
    Dim prt As Presentation
    
    Set prt = ActivePresentation
    For Each sld In prt.Slides      '遍历所有幻灯片
        For Each sp In sld.Shapes   '遍历每张幻灯片里的每一个图形
            On Error Resume Next    '重要：有些形状（如图片）无字体属性，需要这句话，出错时跳过不即出程序
            With sp.TextFrame.TextRange.Font    'With结构，设置字体的下列属性
                .Name = "Arail"                 '设置西文字体
                .NameFarEast = "微软雅黑"       '设置中文字体
                .Size = 16                      '设置字号
                .Bold = True                    '字体加粗
                .Color = RGB(0, 255, 255)       '文字颜色
            End With
        Next
    Next
    Set prt = Nothing
End Sub