繁体   English   中英

VBA Word:删除打开时的编辑限制,关闭时再次限制

[英]VBA Word: remove editing restriction at opening and restrict again when closing

是否可以设置一个宏,该宏将在每次打开Word文档并检查是否有编辑限制时触发。 如果是这样,请尝试从密码列表(硬编码)中输入密码。 万一密码成功,请将其保存在内存中,删除限制,然后在关闭文档时重新应用该限制。

这样,如果我对使用和限制的文档始终使用相同的密码,则可以在计算机上打开它们,就好像没有限制一样,但是该限制仍然适用于其他用户。

注意:Private Sub Document_Open()中的宏仅在我从计算机打开的所有文档上都需要触发。 文件必须是.docx,而不是.docm。

谢谢。

不是代码编写服务,但我有点喜欢这个想法, 这应该使您有个良好的开端。

注意1:您将需要将其放入.dotm文件中,并最终将其另存为PC上的全局模板(google)。

注意2:如果您打开多个文档,这将失败,因为仅存储了1个密码-您可以将密码写为文档属性(在保存和重新锁定之前可以检索并删除)。

取决于您是否乐意将代码添加到Normal.dotm模板(我个人不是)将影响您的操作方式。

如果不使用Normal.dotm,则需要设置一个全局模板并通过创建自己的应用程序事件来触发代码,如下所述: https : //wordmvp.com/FAQs/MacrosVBA/PseudoAutoMacros.htm

如果使用Normal.dotm,则在ThisDocument添加:

Private Sub Document_Open()
    MsgBox ActiveDocument.Name
    Dim oDoc As Object
    Set oDoc = ActiveDocument
    unlocker oDoc
End Sub

并(在测试中)在常规模块中添加以下内容(您稍后可能会希望将其拆分为单独的代码单元):

Sub unlocker(ByVal docToUnlock As Document)
    If Not docToUnlock.Type = wdTypeDocument Then
        ' this is a template, don't try anything
        MsgBox "Not a doc"
        GoTo endOfSub
        Else
        MsgBox "Is a doc"
    End If


    Dim passWords() As String
    passWords = Split("pw1,pw2,pw3", ",")

    Dim iLoop As Long
    iLoop = LBound(passWords)

    On Error GoTo err_Test:

    Do While Not ActiveDocument.ProtectionType = wdNoProtection
        If iLoop > UBound(passWords) Then Exit Do

        oldpassword = passWords(iLoop)

        ActiveDocument.Unprotect oldpassword
        iLoop = iLoop + 1
    Loop

    If Not ActiveDocument.ProtectionType = wdNoProtection Then
        ' unable to unlock document, quit
        oldpassword = vbNullString
        MsgBox "Failed to Unlock"
        GoTo endOfSub
    Else
        MsgBox "Unlocked"
    End If

    ' Do Stuff

    If Not oldpassword = vbNullString Then
        ActiveDocument.Protect wdAllowOnlyReading, Password:=oldpassword
    End If

endOfSub:
    Exit Sub

err_Test:
    If Err.Number = 5485 Then
        ' ignore error due to wrong password
        Err.Clear
        Resume Next
    Else
        ' handle unexpected error
    End If

End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM