VBA macro code to remove BMP, text and seal from documents

mach_9 · #1 09-27-2016, 11:29 AM

I've inherited an application that uses MS Word document templates with macro code. I've converted all of our documents and document templates to Word 2013 but I am having issues when trying to print. There is macro code that removes a BMP and text from the header and footer and a seal which is on the document. This works in Word 2007 but does not work in Word 2013.

I've tried to google it but with no success.

Any help is much appreciated.

Below is the code from the function:

Code:

If UCase(DocType$) = "CERTIFICATE" Then
    'clear the undo stack
    WordBasic.ToolsProtectDocument Type:=2
    WordBasic.ToolsUnprotectDocument
    'get the current re-pagination setting
    Set revDlg = WordBasic.DialogRecord.ToolsRevisions(False)
    WordBasic.CurValues.ToolsRevisions revDlg
    RevisonMarking = revDlg.MarkRevisions
    RevisionsView = revDlg.ViewRevisions
    RevisionsPrint = revDlg.PrintRevisions
    If RevisonMarking > 0 Then
        WordBasic.ToolsRevisions MarkRevisions:=1, ViewRevisions:=0, PrintRevisions:=0
    End If
    UndoCount = 0
    'If the docuement is protected then first unprotect it
    If WordBasic.DocumentProtection() > 0 Then
        WordBasic.ToolsUnprotectDocument
        DocumentProtected = 1
    End If
    WordBasic.EditFindClearFormatting
    WordBasic.StartOfDocument
    WordBasic.ViewHeader
    WordBasic.EditFind Find:="^g", Direction:=0
    WordBasic.EditClear
    UndoCount = UndoCount + 1
    WordBasic.EditFindClearFormatting
    WordBasic.EditFindStyle Style:="Title1"
    WordBasic.EditFind Find:="English Text to be removed", Direction:=0, _
    PatternMatch:=0, Format:=1, Wrap:=1
    If WordBasic.EditFindFound() Then
        WordBasic.Insert " "
        UndoCount = UndoCount + 1
    End If
    WordBasic.EditFindStyle Style:="Title1"
    WordBasic.EditFind Find:="Other English Text to be removed", Direction:=0, _
    PatternMatch:=0, Format:=1, Wrap:=1
    If WordBasic.EditFindFound() Then
        WordBasic.Insert " "
        UndoCount = UndoCount + 1
    End If
    WordBasic.EditFindStyle Style:="Title1"
    WordBasic.EditFind Find:="Other English Text to be removed", Direction:=0, _
    PatternMatch:=0, Format:=1, Wrap:=1
    If WordBasic.EditFindFound() Then
        WordBasic.Insert " "
        UndoCount = UndoCount + 1
    End If
    WordBasic.EditFindClearFormatting
    WordBasic.CloseViewHeaderFooter
    WordBasic.ViewFooter
    ' this should find the red seal
    WordBasic.EditFind Find:="^g", Direction:=0
    WordBasic.EditClear
    UndoCount = UndoCount + 1
    ' this should find the BMP
    WordBasic.EditFind Find:="^g", Direction:=0
    WordBasic.EditClear
    WordBasic.Insert Chr$(13)
    UndoCount = UndoCount + 1
    WordBasic.CloseViewHeaderFooter
    NumPages = WordBasic.SelInfo(4)
    If NumPages > 1 Then
        WordBasic.WW7_EditGoTo Destination:="p2"
        Rem For some reason page scroll is treated as an edit so count it
        UndoCount = UndoCount + 1
        WordBasic.EditFindClearFormatting
        WordBasic.ViewHeader
        WordBasic.EditFind Find:="^g", Direction:=0
        WordBasic.EditClear
        UndoCount = UndoCount + 1
        WordBasic.EditFindClearFormatting
        WordBasic.EditFindStyle Style:="Title1"
        WordBasic.EditFind Find:="English Text to be removed", Direction:=0, _
        PatternMatch:=0, Format:=1, Wrap:=1
        If WordBasic.EditFindFound() Then
            WordBasic.Insert " "
            UndoCount = UndoCount + 1
        End If
        WordBasic.EditFindStyle Style:="Title1"
        WordBasic.EditFind Find:="Other English Text to be removed", Direction:=0, _
        PatternMatch:=0, Format:=1, Wrap:=1
        If WordBasic.EditFindFound() Then
            WordBasic.Insert " "
            UndoCount = UndoCount + 1
        End If
        WordBasic.EditFindStyle Style:="Title1"
        WordBasic.EditFind Find:="Other English Text to be removed", Direction:=0, _
        PatternMatch:=0, Format:=1, Wrap:=1
        If WordBasic.EditFindFound() Then
            WordBasic.Insert " "
            UndoCount = UndoCount + 1
        End If
        WordBasic.EditFindClearFormatting
        WordBasic.CloseViewHeaderFooter
        WordBasic.ViewFooter
        WordBasic.EditFind Find:="^g", Direction:=0
        If WordBasic.EditFindFound() Then
            WordBasic.EditClear
            UndoCount = UndoCount + 1
        End If
        WordBasic.CloseViewHeaderFooter
    End If
End If
Dim dlg As Object: Set dlg = WordBasic.DialogRecord.FilePrint(False)
WordBasic.CurValues.FilePrint dlg
WordBasic.Dialog.FilePrint dlg
WordBasic.FilePrint dlg
CleanUp:
're-set revisions settings
If RevisonMarking > 0 Then
    WordBasic.ToolsRevisions MarkRevisions:=1, ViewRevisions:=RevisionsView, PrintRevisions:=RevisionsPrint
End If
If UndoCount > 0 Then
    While WordBasic.[CommandValid]("EditUndo") = -1
        WordBasic.EditUndo
    Wend
    UndoCount = 0
    If DocumentProtected = 1 Then
        WordBasic.ToolsProtectDocument
    End If
End If
End Sub

Thank you,

William.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro code that prompts user to enter text, then does find/replace.	sfvegas	PowerPoint	0	01-10-2016 08:02 PM
Macro/VBA code to select ALL text in a textbox in microsoft excel and add a new row	jyfuller	Excel Programming	11	06-01-2015 08:49 PM
I need to convert shaded text into highlighted text on about 80 different long documents. VBA macro?	AustinBrister	Word VBA	8	05-28-2015 02:42 PM
VBA code for Microsoft Word macro — select text and insert footnote	ndnd	Word VBA	10	01-06-2015 01:47 PM
Need help on Macro 03- Find text - if text is blank then remove line	simpleonline1234	Word VBA	1	02-25-2011 02:28 AM