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.

macropod · #2 09-27-2016, 05:42 PM

You have a lot of ancient WordBasic code there, which suggests it was written before Word 97 was released, some two decades ago! The whole lot should be re-written in VBA.

As for what your code is doing, it appears to be clearing content from the page headers. If you're clearing the entire content, that can be done with a lot less fuss than your current approach and, as for the undo processing, if you save the document before printing you could simply reload the saved copy afterwards without all the Undo issues.

Accordingly, it would be helpful if you could clarify what you're going.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

mach_9 · #3 09-28-2016, 05:43 AM

Paul,

As noted earlier, I've inherited this app. and have never worked with WordBasic or VBA.

From what I understand from the user is, when printing the document, two picture BMP's and text are to be removed from the header and footer.

The application actually uses 3 .DOTM files, it opens up a Main.DOTM (this one has the FilePrint(...) ), then a Save.DOTM and then the data.DOTM template which has all of the bookmarks, cells, etc. When you print the data.DOTM template, this should remove the items noted above.

I don't understand why you need the 3 of them, maybe back in the day that is how it was to be done, but as you say, it looks like it needs to be re-written in todays standards or done another way.

I've done some research on the Inet about word basic but there doesn't seem to be much, so trying to figure out some of the code is a little difficult.

Will use the code tags in the future.

Thanks,

William

macropod · #4 09-28-2016, 05:53 AM

Quote:

Originally Posted by mach_9

From what I understand from the user is, when printing the document, two picture BMP's and text are to be removed from the header and footer.

OK, but is there any other header content that is to be retained for print purposes?

mach_9 · #5 09-28-2016, 08:14 AM

In regards to the header, there is no other information that needs to retained for printing. You may ask, why not just remove it, it is needed for viewing purposes.

As for the footer, there is additional text that does need to retained for printing purposes.

I've found some info. on Application.DocumentBeforePrint Event but I'm trying to figure out how to incorporate the event, where as the current .DOTM files use Modules and this is using Class Modules.

Thanks

macropod · #6 09-28-2016, 03:19 PM

In that case, try the following macro. It doesn't yet test the DocType$ variable (first line in your code), because I don't know what the larger context is.

Code:

Sub PrintNoHeader()
Application.ScreenUpdating = False
Dim pState As Variant, bFit As Boolean, Sctn As Section, HdFt As HeaderFooter
Const Pwd As String = ""
With ActiveDocument
  .Save
  pState = False
  If .ProtectionType <> wdNoProtection Then
    pState = .ProtectionType
    .Unprotect Pwd
  End If
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          .Range.Text = vbNullString
        End If
      End With
    Next
  Next
  If pState <> wdNoProtection Then .Protect Type:=pState, NoReset:=True, Password:=Pwd
  Application.Dialogs(wdDialogFilePrint).Show
  Application.DisplayAlerts = wdAlertsNone
  .Reload
  Application.DisplayAlerts = wdAlertsAll
End With
Application.ScreenUpdating = True
End Sub

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