Microsoft Office Forums - [Solved] Run a Macro in Word 2010

Microsoft Office Forums (https://www.msofficeforums.com/)

- Word VBA (https://www.msofficeforums.com/word-vba/)

- -

Run a Macro in Word 2010 (https://www.msofficeforums.com/word-vba/7071-run-macro-word-2010-a.html)

Run a Macro in Word 2010

I have been using Word 97 and had macros that were adding a logo and printing each document that was open. I upgraded to Word 2010, uploaded the macros, and the problem that I am having is that the macro will not cycle through each open document. I typically open 10 documents at a time and run the macro, the macro in 2010 only works on the "active" document that I have open. Here is my print all open documents macro:

Code:

Sub PrintAllOpen()

ActivePrinter = "iR7200-M2"

For Each dDoc In Documents

  dDoc.Activate

  ActiveDocument.PrintOut

Next dDoc

End Sub

Can someone please help??
Thank You!!
Joyce

Hi Joyce,

You shouldn't have to activate each document to print it. Try:

Code:

Sub PrintAllOpen()

Dim dDoc As Document

ActivePrinter = "iR7200-M2"

For Each dDoc In Documents

  dDoc.PrintOut

Next dDoc

End Sub

Thank you so much! The print macro runs perfect. I have another macro that I use to format each document before I send them to the printer. If I attempt to print without formatting, it prints perfectly. If I format the document first, it prints everything and then goes back and prints the active document a second time. Here is my macro for formatting, do you see what I could be doing wrong?

Code:

Sub FormatTheFile()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then

  ActiveWindow.Panes(2).Close

End If

If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type = wdMasterView Then

  ActiveWindow.ActivePane.View.Type = wdPageView

End If

 

FileName$ = GetFileType$()

Select Case FileName$

  Case "IPWSM": Call SecondLogo

  Case "IPWSP": Call SecondLogo

  Case "IOPWSM": Call SecondLogo

End Select

 

ChangeFileOpenDirectory "\\Lion\D$\CLIENTS\Authorization\"

Documents.Open FileName:="LogoFile.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto

ActiveDocument.Shapes("Picture 6").Select

Selection.Copy

ActiveDocument.Close SaveChanges:=False

 

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Selection.Paste

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

ActiveWindow.ActivePane.View.Zoom.Percentage = 25

 

FileName$ = GetFileType$()

Select Case FileName$

  Case "OICPIA": Call OICPIA

  Case "OICPOA": Call OICPOA

  Case "IPSDP", "OPINTM", "IOPWSM", "IPHWP", "IOPWSPM", "IOPHEM", "IOPHEPM", "IOPHWPM", "IOPHWM"

    Selection.EndKey Unit:=wdStory

  Case Else

  'TEMP$ = MsgBox(FileName$ + ": UNKNOWN TYPE.", vbOKOnly, "Error")

End Select

End Sub

 

Sub SecondLogo()

ChangeFileOpenDirectory "\\Lion\D$\CLIENTS\Authorization\"

Documents.Open FileName:="LogoFile.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto

ActiveDocument.Shapes("Picture 5").Select

Selection.Copy

ActiveDocument.Close SaveChanges:=False

 

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Selection.Paste

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Hi Joyce,

There's nothing in the code you posted that has anything to do with printing, per se. It's all about inserting one or two logos into the document header. If I've understood that code correctly, it could be simplified to:

Code:

Sub FormatTheFile()

Dim DocLogo As Document, DocMain As Document

Set DocMain = ActiveDocument

Set DocLogo = Documents.Open(FileName:=\\Lion\D$\CLIENTS\Authorization\LogoFile.doc, AddToRecentFiles:=False)

FileName$ = GetFileType$()

Select Case FileName$

  Case "IPWSM", "IPWSP", "IOPWSM"

    DocLogo.Shapes("Picture 5").Copy

    With DocMain.Sections(1).Headers(wdHeaderFooterPrimary).Range

      .Collapse wdCollapseStart

      .Paste

    End With

End Select

DocLogo.Shapes("Picture 6").Copy

With DocMain.Sections(1).Headers(wdHeaderFooterPrimary).Range

  .Collapse wdCollapseEnd

  .Paste

End With

DocLogo.Close SaveChanges:=False

FileName$ = GetFileType$()

Select Case FileName$

  Case "OICPIA", "OICPOA"

    Call OICPIA

  Case "IPSDP", "OPINTM", "IOPWSM", "IPHWP", "IOPWSPM", "IOPHEM", "IOPHEPM", "IOPHWPM", "IOPHWM"

    Selection.EndKey Unit:=wdStory

  Case Else

    'TEMP$ = MsgBox(FileName$ + ": UNKNOWN TYPE.", vbOKOnly, "Error")

End Select

End Sub