VBA PowerPoint Slides 设置自定义布局以刷新布局

Question

我创建了一个脚本来处理许多幻灯片，最后，一些幻灯片的布局似乎有问题。例如，幻灯片编号在某些幻灯片上移动了，但在其他幻灯片上没有移动。可以通过将自定义布局重新分配给幻灯片来手动修复它。

如何自动执行此操作？

我可以遍历所有幻灯片，找出它的自定义布局并重新分配它。但是怎么做？这段代码似乎无限循环：

Dim sld As Slide
Dim layoutName As String
Dim layoutIndex As Integer

       Set sld = Application.ActiveWindow.View.Slide 
       layoutName = sld.CustomLayout.Name
       layoutIndex = getLayoutIndexByName(layoutName)
       ActivePresentation.Slides(y).CustomLayout = ActivePresentation.Designs(y).SlideMaster.CustomLayouts(layoutIndex) 


Function getLayoutIndexByName(xName As String) As Integer
   ActivePresentation.Designs(1).SlideMaster.CustomLayouts.Item (1)
   With ActivePresentation.Designs(1).SlideMaster.CustomLayouts
      For i = 1 To .Count
        Debug.Print ("inLoop Name: " + .Item(i).Name)
        If .Item(i).Name = xName Then
        getLayoutIndexByName = i
        Exit Function
        End If
   Next
   End With

End Function

Answer 1

要简单地重新应用已分配的布局，您只需要这样做：

ActivePresentation.Slides(y).CustomLayout = ActivePresentation.Slides(y).CustomLayout

有时，该命令不起作用，那么这种解决方法值得一试：

DoEvents
Application.CommandBars.ExecuteMso ("SlideReset")
DoEvents

要应用新布局，您需要使用类似以下代码的代码，这与您的代码非常相似：

ActivePresentation.Slides(y).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(GetLayoutIndexFromName("Text Page", ActivePresentation.Designs(1)))

我的 GetLayoutIndexFromName 版本：

Function GetLayoutIndexFromName(sLayoutName As String, oDes As Design) As Long
  Dim x As Long
  For x = 1 To oDes.SlideMaster.CustomLayouts.Count
    If oDes.SlideMaster.CustomLayouts(x).Name = sLayoutName Then
      GetLayoutIndexFromName = x
      Exit Function
    End If
  Next
End Function