2013-02-20 87 views
2

我得到的問題是我的公司模板集在每個word文檔的頁腳中使用了SaveDate字段 - 用於詳細記錄文檔何時保存,這與我們的自定義文檔管理系統有關。如何使用VBA鎖定/解鎖Microsoft Word 2010文檔中的所有字段?

隨後,當用戶想要使用Office 2010的「另存爲PDF」功能製作舊文檔的PDF時,「保存日期」會更新 - 創建舊文檔的PDF,但使用當前日期。這是錯誤的。我們只是試圖創建一個真正的PDF文件,不管原始文件在哪裏。

爲了解決這個問題,我正在編寫一個鎖定字段的宏解決方案,將文檔作爲PDF導出,然後再次解鎖字段。

我遇到了一個問題,我可以識別並鎖定頁眉/頁腳中的所有字段(這實際上是我正在嘗試做的),但爲了使它更健壯,需要找到一種方法鎖定所有區域中的所有區域。

向您展示我的代碼如何識別所有部分中的所有字段?這是否需要使用索引工具來完成?

Sub CPE_CustomPDFExport() 

'20-02-2013 

    'The function of this script is to export a PDF of the active document WITHOUT updating the fields. 
    'This is to create a PDF of the document as it appears - to get around Microsoft Word 2010's native behaviour. 

'Route errors to the correct label 
'On Error GoTo errHandler 

'This sub does the following: 

    ' -1- Locks all fields in the specified ranges of the document. 
    ' -2- Exports the document as a PDF with various arguments. 
    ' -3- Unlocks all fields in the specified ranges again. 
    ' -4- Opens up the PDF file to show the user that the PDF has been generated. 

     'Lock document fields 
     Call CPE_LockFields 

     'Export as PDF and open afterwards 
     Call CPE_ExportAsPDF 

     'Unlock document fields 
     Call CPE_UnlockFields 

'errHandler: 
' MsgBox "Error" & Str(Err) & ": " & 

End Sub 
Sub CPE_LockFields() 

    'Update MS Word status bar 
     Application.StatusBar = "Saving document as PDF. Please wait..." 

    'Update MS Word status bar 
     Application.StatusBar = "Locking fields in all section of the active document..." 

    'Declare a variable we can use to iterate through sections of the active document 
     Dim docSec As section 

    'Loop through all document sections and lock fields in the specified ranges 
     For Each docSec In ActiveDocument.Sections 
      docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = True 
      docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = True 
      docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = True 
     Next 

End Sub 
Sub CPE_UnlockFields() 

    'Update MS Word status bar 
     Application.StatusBar = "PDF saved to DocMan Temp. Now unlocking fields in active document. Please wait..." 

    'Declare a variable we can use to iterate through sections of the active document 
     Dim docSec As section 

    'Loop through all document sections and unlock fields in the specified ranges 
     For Each docSec In ActiveDocument.Sections 
        docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = False 
        docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = False 
        docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = False 
     Next 

End Sub 
Sub CPE_ExportAsPDF() 

    'Update MS Word status bar 
    Application.StatusBar = "Saving document as PDF. Please wait..." 

    'Chop up the filename so that we can remove the file extension (identified by everything right of the first dot) 
    Dim adFilename As String 
    adFilename = Left(ActiveDocument.FullName, (InStrRev(ActiveDocument.FullName, ".", -1, vbTextCompare) - 1)) & ".pdf" 

    'Export to PDF with various arguments (here we specify file name, opening after export and exporting with bookmarks) 
     With ActiveDocument 

        .ExportAsFixedFormat outPutFileName:=adFilename, _ 
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, _ 
        OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _ 
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ 
        CreateBookmarks:=wdExportCreateWordBookmarks, DocStructureTags:=True, _ 
        BitmapMissingFonts:=True, UseISO19005_1:=False 

     End With 

     'Update MS Word status bar 
     Application.StatusBar = "PDF saved to DocMan Temp." 

End Sub 
+0

也許我誤解了。讓我再回到你的這個 – 2013-02-20 13:44:54

+0

非常感謝,感謝如果你有時間 – Thomas 2013-02-20 13:46:43

+0

我正在做一些測試,並會回發一旦他們完成:) – 2013-02-20 13:49:40

回答

1

嘗試類似下面去文檔,頁眉,頁腳,背景和正文所有領域:

Sub LockAllFieldsInDocument(poDoc As Document, Optional pbLock As Boolean = True) 
    Dim oRange As Range 

    If Not poDoc Is Nothing Then 
     For Each oRange In poDoc.StoryRanges 
      oRange.Fields.Locked = pbLock 
     Next 
    End If 

    Set oRange = Nothing 
End Sub 
+0

我試着這 - 它看起來像一個工作的解決方案到目前爲止 - 似乎捕捉了一切。只是做一些測試,所以我會讓你知道我的票價! – Thomas 2013-02-20 14:07:57

+0

試圖將Sub AutoNew()用於模板 - 但它不起作用,如果模板有多個字段,不知道爲什麼.. – 2014-11-12 09:07:01