How to Print Images and Shapes Only in Your Word Document via VBA

In the following post, we would like to offer you the way to print images and shapes only in your Word document via VBA.

A Word document can both contain text and images, as well as shapes, such as text boxes. Together they make a professional document. However, there are times when just part of them is needed while printing. It can be to print only text or images and shapes. Sadly, there is no direct built-in function in Word to do so.

But, you can always utilize VBA codes to perform task. As a matter of fact, we’ve talked about how to print only text via VBA in following article: How to Auto Hide Images and Shapes via VBA when Printing Your Word Document

Today, let’s see the way to print images and shapes only.

Print Images and Shapes in a Single Document

1. First and foremost, press “Alt+ F11” to invoke VBA editor.
2. Then click “Normal” project in VBA editor.
3. Next click “Insert” tab and choose “Module”.   
4. Open new module by double click.
5. And paste following codes there:

Sub PrintImagesOrShapesOnlyInDoc()
  Dim objshapes As Shape
  Dim objInlineShape As InlineShape
  Dim strDocName As String
  Dim objRange As Range
  Dim objNewDoc As Document

  Selection.WholeStory
  Selection.Copy
  Set objNewDoc = Documents.Add
  Windows(objNewDoc.FullName).Activate
  Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
  ActiveWindow.ActivePane.VerticalPercentScrolled = 0
    If ActiveDocument.InlineShapes.Count > 0 Then
      For Each objInlineShape In ActiveDocument.InlineShapes
        objInlineShape.ConvertToShape
      Next objInlineShape
    End If  
    Set objRange = ActiveDocument.Content     
    objRange.Find.ClearFormatting
    objRange.Find.Replacement.ClearFormatting
    With objRange.Find
      .Text = "[^2-^255]{1,}"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchWildcards = True
    End With
    objRange.Find.Execute Replace:=wdReplaceAll
    Do While ActiveDocument.Shapes.Count > 0
     For Each objshapes In ActiveDocument.Shapes
       objshapes.ConvertToInlineShape
     Next objshapes
    Loop

    Dialogs(wdDialogFilePrint).Show
    ' If you don't want to pop up the print dialog, change the codes "Dialogs(wdDialogFilePrint).Show" into the codes below
    ' ActiveDocument.PrintOut
  
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    ' You'd better activate the codes below when you print images or shapes in multiple Documents.
    ' ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

End Sub

6. Next hit “F5” to run the macro.
7. First there is the “Print” dialog. Set all printing settings, such as choosing a printer. Then click “OK”.

Here is the outcome:

Modify Codes if Necessary

By the way, if you want no “Print” dialog popping up, you can add a comment symbol, i.e. the single quotation mark, to this code line:

Dialogs(wdDialogFilePrint).Show

And remove the comment symbol before this line:

'ActiveDocument.PrintOut

Also, the macro shall leave the document open after printing. To close it, remove the comment symbol before this line:

'ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

Print Images and Shapes in Multiple Documents

1. To begin with, you ought to arrange all target documents in the same folder.
2. Then install and run macro following exact the same steps above.
3. It’s recommend modifying codes as we instruct in “Modify Codes if Necessary” section.
4. Next open the module you created to hold macro “PrintImagesOrShapesOnlyInDoc”. Below it, you paste this macro:

Sub PrintImagesOrShapesOnlyInMultipleDocs()
  Dim dlgFile As FileDialog
  Dim objDoc As Document
  Dim StrFolder As String
  Dim strFile As String

  Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
  With dlgFile
    If .Show = -1 Then
      StrFolder = .SelectedItems(1) & "\"
    Else
      MsgBox ("No folder is selected!")
      Exit Sub
    End If
  End With

  strFile = Dir(StrFolder & "*.docx", vbNormal)
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=StrFolder & strFile  
    Call PrintImagesOrShapesOnlyInDoc  
    strFile = Dir()
  Wend   
End Sub

Run the macro and you will see the “Browse” window open, select the target folder and click “OK”. And that’s it.

Mind the Data Loss

Word is very much related to our daily work. So it can cast overwhelming effect on business if it collapses. Therefore, it’s a good habit to generate a regular backup plan. Then you will have the latest version of data to refer to. Besides, it’s better to get a repairing tool to fix damaged docx.

Author Introduction:

Vera Chen is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including Excel fix and pdf repair software products. For more information visit www.datanumen.com