请问怎么能用Vba批量修改ppt中表格的字体和字体大小

hope98 · 发表于 2021-8-12 14:43

工作当中总是处理不同人做的ppt,表格的样式都不统一，需要通过vba统一修改ppt中表格的字体、颜色、大小，费时费力，有没有什么办法。例如将附件中多张ppt中表格的字体统一变成“微软雅黑”，字号统一调成“10”，还请大神指导。

lss001 · 发表于 2021-8-13 09:27

本帖最后由 lss001 于 2021-8-14 11:53 编辑

Sub ppt表格格式设置()
Dim oShape As Shape, oSlide As Slide, rng As TextRange, ppt As Presentation
Set ppt = Application.ActivePresentation
      For Each oSlide In ppt.Slides
            For Each oShape In oSlide.Shapes
                     '判断是否含有表格
                     If oShape.HasTable Then
                        With oShape.Table
                        For i = 1 To .Rows.Count
                        For j = 1 To .Columns.Count
                              Set rng = .Cell(i, j).Shape.TextFrame.TextRange
                              With rng.Font
                                    .Name = "微软雅黑" '字体
                                    .Size =  10 '大小
                                    .Color = RGB(255, 120, 0)'颜色//RGB
                              End With
                        Next j, i
                        End With
                     End If
            Next
      Next
End Sub

hope98 · 发表于 2021-8-13 17:22

感谢您提供的代码，运行后，可以把ppt上其他文本框的内容改成微软雅黑字体，但改不了表格上的字体，
有没有可以改变ppt里表格里的字体办法，感谢感谢！

lss001 · 发表于 2021-8-13 21:02

hope98 发表于 2021-8-13 17:22
感谢您提供的代码，运行后，可以把ppt上其他文本框的内容改成微软雅黑字体，但改不了表格上的字体，
有没 ...

参考楼上修改代码！！！

hope98 · 发表于 2021-8-17 09:55

非常感谢，这段代码执行后字体大小改了，但是表格字体还是ppt里默认的“等线”，并没有改成“微软雅黑“，不知道问题出在哪？是不是表格的字体根本就没法调整？

前进者 · 发表于 2022-2-26 15:16

标记一下，以便后期学习！

lss001 · 发表于 2022-3-26 18:42

本帖最后由 lss001 于 2022-3-27 09:20 编辑

hope98 发表于 2021-8-17 09:55
非常感谢，这段代码执行后字体大小改了，但是表格字体还是ppt里默认的“等线”，并没有改成“微软雅黑“， ...

Sub ppt表格格式设置()
Set ppt = ActivePresentation
      For Each oSlide In ppt.Slides
         For Each oShape In oSlide.Shapes
            If oShape.HasTable Then
               For Each oRow In oShape.Table.Rows
                  For Each oCell In oRow.Cells
                     With oCell.Shape.TextFrame.TextRange.Font
                           .Name = "微软雅黑" '字体
                           .Size =  10 '大小
                           .Color = RGB(255, 120, 0)'颜色
                     End With
                  Next
               Next
               End If
         Next
      Next
End Sub

		自动登录	找回密码
密码			免费注册