2013-02-20 78 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