簡體   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