Question

我在Excel宏方面有不错的技能，但是在使用新的PowerPoint（> 2013）时，我必须手动完成所有操作，而且很多我找不到的对象。我必须重新格式化PowerPoint幻灯片（> 150）和各种表格。我需要将表重置为Medium Style 2 Accent 1，然后更改列和行的尺寸。我正在使用PowerPoint 2016。

在各种论坛和Google的帮助下，我有以下代码

Sub Reformat_slide ()

Dim s As Slide
Dim oSh As Shape
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long

  Set s = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
  s.Select
  s.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(15)
'  Required to reset the slide format
  DoEvents
  Application.CommandBars.ExecuteMso ("SlideReset")
  DoEvents

  For Each oSh In s.Shapes
'  Force Title to a particular font,  setting the custom slide layout does not always  change it
    If Left(oSh.Name, 5) = "Title" Then
      With oSh.TextFrame.TextRange
        .Font.Name = "Tahoma(Header)"
        .Font.Size = 24
        .Font.Bold = False
      End With
    End If

'  Force Table for a specific format - Medium Style 2 Accent 1.
    If oSh.HasTable Then
      Set oTbl = oSh.Table
      oTbl.ApplyStyle ("{5C22544A-7EE6-4342-B048-85BDC9FD1C3A}"), True

      oSh.Height = 0
'
'       oSh.Left = InchesToPoints(.25)  is not working
      oSh.Left = 72 * 0.25
      oSh.Top = 72 * 1.3

      oTbl.Columns(1).Width = 72 * 1.3
      oTbl.Columns(2).Width = 72 * 3.55
      oTbl.Columns(3).Width = 72 * 1.3
      oTbl.Columns(4).Width = 72 * 1.1
      oTbl.Columns(5).Width = 72 * 2.25

      For lRow = 1 To oTbl.Rows.Count
        For lCol = 1 To oTbl.Columns.Count
          With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
            .Font.Name = "Tahoma(Body)"
            .Font.Size = 12
            .Font.Color = RGB(64, 65, 70)  ' Standard Light Green
            If lRow = 1 Or lCol = 1 Then .Font.Bold = True
            If lRow = 1 Then .ParagraphFormat.Alignment = ppAlignCenter
            .ParagraphFormat.SpaceAfter = 0
            .ParagraphFormat.SpaceBefore = 0
          End With
          With oTbl.Cell(lRow, lCol).Shape.TextFrame
            .VerticalAnchor = msoAnchorMiddle
            .MarginLeft = 72 * 0.05
            .MarginRight = 72 * 0.05
            .MarginTop = 72 * 0.04
            .MarginBottom = 72 * 0.04
          End With
       Next
      Next
    End If
  Next   ' Shape
End Sub

我有几个问题。

1）幻灯片：重置幻灯片并不总是有效。我无法确定何时或何时不起作用的任何模式。尽管可以手动执行，但始终可以使用。

2）表格样式：重置表格样式并不总是有效。我必须有一个新的幻灯片，一个新的表格并复制并粘贴数据。同样，如果我手动重置样式（选择表，“表工具设计”选项卡，然后选择“表样式”），它将正确重置。通常边界会保持黑色，但在重置后边界应为白色。

3）表格边距：我需要重置表格边距，可以手动对整个表格进行设置（选择表格->格式形状->大小和属性->文本框）。我无法确定VBA中的等效对象，因此无法遍历表。（我正在做类似于将高度重置为oSh.Height = 0的最小高度的操作。）

4）表段落对齐：表边距存在相同问题。需要设置中心的垂直对齐方式和中心的水平对齐方式（通过选择表格->格式形状->尺寸和属性->文本框手动完成）。

希望这个小组能为您提供帮助和预先感谢。

Michael Virostko

Answer 1

对于幻灯片重置，您使用的命令在某些情况下可以使用。这是另一种重置，可以在其他重置中使用，实际上，您可能需要使用其中一种：

s.CustomLayout = s.CustomLayout

以下是设置单元格边距和对齐方式的方法：

Sub FormatTable()
  Dim oTable As Table
  Dim oCell As Cell
  Dim ThisRow As Integer
  Set oTable = ActivePresentation.Slides(1).Shapes(1).Table
  For ThisRow = 1 To oTable.Rows.Count
    For Each oCell In oTable.Rows(ThisRow).Cells
      With oCell.Shape.TextFrame
        .MarginTop = 1
        .MarginRight = 1
        .MarginBottom = 1
        .MarginLeft = 1
        .HorizontalAnchor = msoAnchorCenter
        .VerticalAnchor = msoAnchorMiddle
      End With
    Next oCell
  Next ThisRow
End Sub

PowerPoint中使用VBA的表格格式

1 个答案: