ppt VBA代码，怎样操作删除母版视图中“任何幻灯片都不使用”的版式？谢谢！

happysun1228

PowerPoint2007文件，点开母版视图，会看到很多版式页面有“任何幻灯片都不使用”的提示，如何使用vba代码，一键操作将这些都不使用的版式页面删除掉？

sodm

在网上找了好久，最后自己琢磨出来的。试了试可以解决问题。

Option Explicit

Sub ModifyDesign()
    Dim oSlide As Slide
    Dim Dic As Object, i As Long
   
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each oSlide In ActivePresentation.Slides
        Dic(oSlide.Design.Index) = ""
    Next oSlide
   
    For i = ActivePresentation.Designs.Count To 1 Step -1
        If Not Dic.exists(i) Then ActivePresentation.Designs(i).Delete
    Next i
   
    Set Dic = Nothing
End Sub

leikaiyi123

sodm 发表于 2019-1-18 13:22
在网上找了好久，最后自己琢磨出来的。试了试可以解决问题。

Option Explicit

有些能删，可发现有些删不了，能找下附件这个删不了的原因么？

sodm

此段代码，用来删除PPT中有“幻灯片母版：任何幻灯片都不使用”的情况。不适用删除母版下一阶的“版式：任何幻灯片都不使用”这种情况。
你的PPT我打开看了，只有一个母版，所以不用删除。
可以到菜单栏中的“视图”，然后点击“幻灯片母版”。查看一下自己的母版。

leikaiyi123

sodm 发表于 2019-1-21 11:19
此段代码，用来删除PPT中有“幻灯片母版：任何幻灯片都不使用”的情况。不适用删除母版下一阶的“版式：任 ...

3楼我的附件中：
第一张母版显示：诗情画意 幻灯片母版：由幻灯片1使用
第二张母版显示：诗情画意 标题母版：任何幻灯片都不使用
不适用删除“任何幻灯片都不使用”的标题母版吗？代码能修改吗？

sodm

根据你的要求，以下代码可以同时删除任何幻灯片都不使用的母版和版式。不过个人还是觉得母版应该有多个版式的，不用的都删除了可能不好，所以建议用2楼的代码。

Option Explicit
Sub DeleteUnusedMaster()
    Dim oSlide As Slide
    Dim Dic As Object, i As Long, j As Long
    Dim oDicItem As Variant, DicItem As Variant
    Dim oFlag As Boolean
   
    Set Dic = CreateObject("Scripting.Dictionary")
    '获得幻灯片母版编号和版式名称
    For Each oSlide In ActivePresentation.Slides
        Dic(oSlide.Design.Index) = Dic(oSlide.Design.Index) & "," & oSlide.CustomLayout.Name
    Next oSlide
    '删除任何幻灯片都不使用母版和版式
    For i = ActivePresentation.Designs.Count To 1 Step -1
        With ActivePresentation.Designs(i)
            If Not Dic.exists(i) Then
                .Delete
            Else
                DicItem = Split(Right(Dic(i), Len(Dic(i)) - 1), ",")
                For j = .SlideMaster.CustomLayouts.Count To 1 Step -1
                    oFlag = False
                    For Each oDicItem In DicItem
                        If oDicItem = .SlideMaster.CustomLayouts(j).Name Then oFlag = True
                    Next oDicItem
                    If oFlag = False Then .SlideMaster.CustomLayouts(j).Delete
                Next j
            End If
        End With
    Next i
   
    Set Dic = Nothing
End Sub

leikaiyi123

sodm 发表于 2019-1-22 10:31
根据你的要求，以下代码可以同时删除任何幻灯片都不使用的母版和版式。不过个人还是觉得母版应该有多个版式 ...

谢谢老师的升级代码。
测试发现：1、在ppt2003中.SlideMaster没有.CustomLayouts这个属性：显示方法和数据成员未找到。
2、ppt2010中.SlideMaster.CustomLayouts(j).Delete这句出错，显示:
运行时错误  '-2147188160 (80048240)。
Slide (unknown member)：Invalid request. Can't delete master.
但：加入On Error Resume Next后，能删除“任何幻灯片都不使用”的母版。
可能还需完善一下。

sodm

由于PPT2003到PPT2007微软设计思路不同，代码无法做到兼顾，只好分开。PPT2010遇到的错误已完善，经自己测试可以正常运行。

PPT2003 删除任何幻灯片都不使用的母版，代码如下：

Option Explicit
Sub ModifyDesign()
    Dim oSlide As Slide
    Dim Dic As Object, i As Long
   
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each oSlide In ActivePresentation.Slides
        Dic(oSlide.Design.Index) = ""
    Next oSlide
   
    For i = ActivePresentation.Designs.Count To 1 Step -1
        If Not Dic.exists(i) Then ActivePresentation.Designs(i).Delete
    Next i
   
    Set Dic = Nothing
End Sub

PPT2007/2010 删除任何幻灯片都不使用的母版和版式，代码如下：（备注：PPT2010以上的未测试过，欢迎大家测试告知结果）

Option Explicit
Sub DeleteUnusedMaster()
    Dim oSlide As Slide
    Dim Dic As Object, i As Long, j As Long
    Dim oDicItem As Variant, DicItem As Variant
    Dim oFlag As Boolean
   
    Set Dic = CreateObject("Scripting.Dictionary")
    '获得幻灯片母版编号和版式名称
    For Each oSlide In ActivePresentation.Slides
        Dic(oSlide.Design.Index) = Dic(oSlide.Design.Index) & "," & oSlide.CustomLayout.Name
    Next oSlide
    '删除任何幻灯片都不使用母版和版式
    For i = ActivePresentation.Designs.Count To 1 Step -1
        With ActivePresentation.Designs(i)
            If Not Dic.exists(i) Then
                .Delete
            Else
                DicItem = Split(Right(Dic(i), Len(Dic(i)) - 1), ",")
                For j = .SlideMaster.CustomLayouts.Count To 1 Step -1
                    oFlag = False
                    For Each oDicItem In DicItem
                        If oDicItem = .SlideMaster.CustomLayouts(j).Name Then oFlag = True
                    Next oDicItem
                    If oFlag = False Then .SlideMaster.CustomLayouts(j).Delete
                Next j
            End If
        End With
    Next i
   
    Set Dic = Nothing
End Sub