PPT中使用宏修改标题属性

夏日已末

标题格式：一级标题   中文数字加、例如 一、二级标题  中文数字加：   例如二：三级标题  小写数字加、  例如3、
使用方法： 打开PPT  按alt+f11，打开vb编辑框，选择插入模块

把代码复制进去按F5就ok了


效果



代码如下，我都标注释了，可以根据自己的要求自己修改

[Visual Basic] 纯文本查看 复制代码

Sub Change()
    Dim s       As Slide
    Dim shp     As Shape
    Dim trng    As TextRange
    Dim i       As Integer
    
          'Slides.Shapes(1).AddShape(msoShapeRectangle, 0, 0, 250, 140).TextFrame

            '  Slides.Shapes(1).TextFrame.TextRange.Characters.Text = "文sadasd字"
    ' /* 遍历活动窗口中打开的演示文稿中的幻灯片. */
    For Each s In ActivePresentation.Slides
        ' /* 遍历当前幻灯片中的形状对象. */
        For Each shp In s.Shapes
            ' /* 当前幻灯片中的当前形状含有文本框架. */
            If shp.HasTextFrame Then
                ' /* 当前幻灯片中的当前形状包含文本. */
                If shp.TextFrame.HasText Then
                    ' 引用文本框架中的文本.
                    Set trng = shp.TextFrame.TextRange
                    
                     For i = 1 To trng.Characters.Count
                        '判断是否为大标题  格式是  一、
                        If trng.Characters(i).Text = "一" _
                        Or trng.Characters(i).Text = "二" _
                        Or trng.Characters(i).Text = "三" _
                        Or trng.Characters(i).Text = "四" _
                        Or trng.Characters(i).Text = "五" _
                        Or trng.Characters(i).Text = "六" _
                        Or trng.Characters(i).Text = "七" _
                        Or trng.Characters(i).Text = "八" _
                        Or trng.Characters(i).Text = "九" _
                        Or trng.Characters(i).Text = "十" _
                            Then
                            If (trng.Characters(i + 1).Text = "、") Then
                            '设置字体格式
                            trng.Font.Name = "微软雅黑"
                            trng.Font.Size = "32"
                            trng.Font.Color.RGB = RGB(Red:=50, Green:=50, Blue:=150)
                            
                            '文本框在当页的位置
                            shp.Top = 20
                            shp.Left = 20
                            
                                '设置文本属性
                                With shp
                                .TextFrame.HorizontalAnchor = msoAnchorNone
                                .TextFrame.MarginTop = 0       '字体在边框中的位置
                                .TextFrame.MarginBottom = 0
                                .TextFrame.MarginLeft = 0
                                .TextFrame.MarginRight = 0
                                .TextFrame.VerticalAnchor = msoAnchorMiddle     '设置垂直对齐方式
                                .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft   '设置对齐方式
                                
                                'shp.TextFrame.Orientation                       '设置文本框方向
                                'shp.TextFrame.WordWrap                          '自动换行
                                
                                End With
                            End If
                        End If
                        
                        '判断二级标题 格式是  一：
                        If trng.Characters(i).Text = "一" _
                        Or trng.Characters(i).Text = "二" _
                        Or trng.Characters(i).Text = "三" _
                        Or trng.Characters(i).Text = "四" _
                        Or trng.Characters(i).Text = "五" _
                        Or trng.Characters(i).Text = "六" _
                        Or trng.Characters(i).Text = "七" _
                        Or trng.Characters(i).Text = "八" _
                        Or trng.Characters(i).Text = "九" _
                        Or trng.Characters(i).Text = "十" _
                            Then
                            If (trng.Characters(i + 1).Text = "：") Then
                            '设置字体格式
                            trng.Font.Name = "微软雅黑"
                            trng.Font.Size = "20"
                            trng.Font.Color.RGB = RGB(Red:=100, Green:=0, Blue:=0)
                            
                            '文本框在当页的位置
                            shp.Top = 80
                            shp.Left = 20
                            
                                '设置文本属性
                                With shp
                                .TextFrame.HorizontalAnchor = msoAnchorNone
                                .TextFrame.MarginTop = 0       '字体在边框中的位置
                                .TextFrame.MarginBottom = 0
                                .TextFrame.MarginLeft = 0
                                .TextFrame.MarginRight = 0
                                .TextFrame.VerticalAnchor = msoAnchorMiddle     '设置垂直对齐方式
                                .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft   '设置对齐方式
                                
                                'shp.TextFrame.Orientation                       '设置文本框方向
                                'shp.TextFrame.WordWrap                          '自动换行
                                End With
                            End If
                        End If
                        
                         '判断三级标题 格式是  1.
                        If trng.Characters(i).Text = "1" _
                        Or trng.Characters(i).Text = "2" _
                        Or trng.Characters(i).Text = "3" _
                        Or trng.Characters(i).Text = "4" _
                        Or trng.Characters(i).Text = "5" _
                        Or trng.Characters(i).Text = "6" _
                        Or trng.Characters(i).Text = "7" _
                        Or trng.Characters(i).Text = "8" _
                        Or trng.Characters(i).Text = "9" _
                        Or trng.Characters(i).Text = "10" _
                            Then
                            
                            If (trng.Characters(i + 1).Text = "、") Then
                            '设置字体格式
                            trng.Font.Name = "微软雅黑"
                            trng.Font.Size = "20"
                            trng.Font.Color.RGB = RGB(Red:=0, Green:=100, Blue:=0)
                            
                            '文本框在当页的位置
                            shp.Top = 120
                            shp.Left = 30
                            
                            '设置文本属性
                                With shp
                                .TextFrame.HorizontalAnchor = msoAnchorNone
                                .TextFrame.MarginTop = 0       '字体在边框中的位置
                                .TextFrame.MarginBottom = 0
                                .TextFrame.MarginLeft = 0
                                .TextFrame.MarginRight = 0
                                .TextFrame.VerticalAnchor = msoAnchorMiddle     '设置垂直对齐方式
                                .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft   '设置对齐方式
                                
                                'shp.TextFrame.Orientation                       '设置文本框方向
                                'shp.TextFrame.WordWrap                          '自动换行
                                End With
                            End If
                        End If
                        
                    Next
                    ' /* 遍历文本框架中的每一个字符. */
                   
                    
                End If
            End If
        Next
    Next
End Sub

Xw丶小威

这个代码我都不知道怎么写。。。

zeknight

楼主，请问有没有加版权的宏？

夏日已末

zeknight 发表于 2018-12-17 17:23
楼主，请问有没有加版权的宏？

不好意思，没有哦

zeknight

夏日已末 发表于 2018-12-18 08:53
不好意思，没有哦

非常感谢，我遇到一个情况，在PPT下方有个版权的图片，不能选择也不能删掉。

通过PPT的窗格可以查看，但是不能选择。

同时，这个图片也不是在PPT母版里面，不知道通过什么方法加上去的

夏日已末

zeknight 发表于 2018-12-18 12:49
非常感谢，我遇到一个情况，在PPT下方有个版权的图片，不能选择也不能删掉。

通过PPT的窗格可以查看， ...

这个我也不太清楚哦，我不是专业做PPT的，用宏添加的应该和普通控件一样可以删除的。高级的红我也没见过。

oneofzero

多谢楼主分享