在 PowerPoint 中只读时使用宏解锁

Question

我想使用 PowerPoint 宏删除只读。

我正在编写一个在打开文件时触发的宏。在该宏中，有一个删除特定形状的过程。 PowerPoint 文件有写锁。

鉴于以上假设，当您以只读方式打开文件时宏会执行，但会报错，因为它是只读的，不能删除形状。

所以我在执行宏的时候解开了只读锁当我完成删除特定形状后，我想再次将其锁定为只读。

有这样的方法吗？我知道写锁密码

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
  Const EXP_DATE As Date = "2021/09/30"
  
  Dim NOW_DATE As Date: NOW_DATE = Format(Date, "yyyy/mm/dd")
  
  Dim pp As PowerPoint.Presentation: Set pp = ActivePresentation
  
  If NOW_DATE <= EXP_DATE Then
    MsgBox "OK!"
    Call DeleteShapesWithName("expShape")
  Else
    MsgBox "No!Exp!：" + Format(EXP_DATE, "yyyy/mm/dd")
    
    'ActivePresentation.Close
  End If
End Sub

Sub DeleteShapesWithName(ByVal targetName As String)
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Long
    i = 1
    For Each sld In Application.ActivePresentation.Slides
        Do Until i > sld.Shapes.Count
            If sld.Shapes(i).Name = targetName Then
                sld.Shapes(i).Delete
            Else
                i = i + 1
            End If
        Loop
    Next
End Sub

------添加
收到回复后添加修改源

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
    Call UnlockPresentation
End Sub


Sub UnlockPresentation()
    Dim oPVW As ProtectedViewWindow
    Dim oPres As Presentation
    
    Set oPVW = ProtectedViewWindows.Open("C:\test\example_exp.pptm")
    oPVW.Edit ModifyPassword:="test"
        
    Call DeleteShapesWithName("expShape")
    'Do stuff here
End Sub

Sub DeleteShapesWithName(ByVal targetName As String)
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Long
    i = 1
    For Each sld In Application.ActivePresentation.Slides
        Do Until i > sld.Shapes.Count
            If sld.Shapes(i).Name = targetName Then
                sld.Shapes(i).Delete
            Else
                i = i + 1
            End If
        Loop
    Next
End Sub

Answer 1

这是打开只读演示文稿的代码，您可以对其进行修改。无需重置密码，只需将“Test”替换为实际密码即可。 Do stuff here注释所在的地方，可以使用ActivePresentation关键字修改文件：

Sub UnlockPresentation()
    Dim oPVW As ProtectedViewWindow
    Dim oPres As Presentation
    
    Set oPVW = ProtectedViewWindows.Open("C:\HasModPW.pptx")
    oPVW.Edit ModifyPassword:="ExistingModificationPassword"
    'Do stuff here
End Sub

请注意：Microsoft 在 ProtectViewWindow.Edit 上的帮助页面是错误的。页面目前说的是这个方法修改密码，其实是提供了密码可以编辑，

在 PowerPoint 中只读时使用宏解锁

Unlock with macro when read-only in PowerPoint

powerpoint

vba