CODEWITHSUNDEEP
vbaexcelms-office
Shekhar Nalawade
Shekhar Nalawade

Reputation: 127

remove blank pages from word file

I am using a word object to reference the word document. I am copying some images to each page and converting that 150+ pages word file to PDF.

Dim wordapp As Object
Set wordapp = CreateObject("Word.Application")

To add 1st page to that word file i am using

wordapp.documents.Add

To add next pages i am using the code in next line,

wordapp.ActiveDocument.Sections.Add

Above code does not insert any blank page in word file and conversion of same to pdf is succesfull.

For your information,

On my computer environment is Windows 10, Office 2013. But When i use same on another computer then it introduces blank pages. Here Windows 10 and Office 2010.

complete code is here. pagenumber specifies that its first time we are trying to create word dcument or not. so nest time only page is added

If pagenumber = 1 Then
Dim wordapp As Object

Set wordapp = CreateObject("Word.Application")
wordapp.documents.Add
wordapp.Visible = False
Application.Wait (Now + TimeValue("0:00:03"))
With wordapp.ActiveDocument.PageSetup
     .LeftMargin = 36
     .RightMargin = 36
     .TopMargin = 36
     .BottomMargin = 36
End With
Else
    'add page at end AND copy the picture ahead of it
    wordapp.ActiveDocument.Sections.Add
    Application.Wait (Now + TimeValue("0:00:03"))
End If

Dim selrange As Range
Application.CutCopyMode = False
Workbooks("" & workbookname).Sheets("Tax Invoice     Format").Range("A1:L47").CopyPicture Appearance:=xlScreen, Format:=xlPicture
wordapp.Selection.Goto wdGoToPage, wdGoToAbsolute, count:=pagenumber
wordapp.Selection.Paste (ppPasteEnhancedMetafile)
wordapp.ActiveDocument.inlineshapes(pagenumber).LockAspectRatio =     msoFalse
wordapp.ActiveDocument.inlineshapes(pagenumber).Height = 735
wordapp.ActiveDocument.inlineshapes(pagenumber).Width = 540
Application.Wait (Now + TimeValue("0:00:03"))

pagenumber = pagenumber + 1
*loop continues*

Upvotes: 0

Views: 2300

Answers (1)

Cindy Meister
Cindy Meister

Reputation: 25663

The reason you're having difficulties is that Sections.Add is not the way to insert new pages into a Word document. A Word "Section" defines a set of page layout formatting, such as portrait vs. landscape, different margin settings, different headers and footers, etc.

There are different kinds of "section breaks", one of which does not create a new page. If you don't specify the kind of page break, Word uses the local default setting (can be user-determined). So probably on the one machine "Next Page" is the default and on the other "Continuous".

The correct way to insert a new page is 

Range.InsertBreak Word.WdBreakType.wdPageBreak 'or the long equivalent: 7

In addition, your code is inefficient and otherwise inaccurate. As in Excel, it's better to work with the underlying objects, especially the Range object.

Here are some suggestions:

'Declare and assign these as appropriate - unsure since we don't see all the code...
Dim wordDoc as Object
Dim wordRange as Object 
Dim wordInlineShape as Object

If pagenumber = 1 Then
  Dim wordapp As Object

  Set wordapp = CreateObject("Word.Application")
  Set wordDoc = wordapp.documents.Add
  Set wordRange = wordDoc.Content
  wordapp.Visible = False
  Application.Wait (Now + TimeValue("0:00:03"))
  With wordDoc.PageSetup
     .LeftMargin = 36
     .RightMargin = 36
     .TopMargin = 36
     .BottomMargin = 36
  End With
Else
    'add page at end AND copy the picture ahead of it
    wordRange.Collapse 0 'Word.WdCollapseDirection.wdCollapseEnd
    wordRange.InsertBreak 7
    Application.Wait (Now + TimeValue("0:00:03"))
End If

Dim selrange As Range
Application.CutCopyMode = False
Workbooks("" & workbookname).Sheets("Tax Invoice Format").Range("A1:L47").CopyPicture Appearance:=xlScreen, Format:=xlPicture

wordRange.Collapse 0 'Word.WdCollapseDirection.wdCollapseEnd
wordRange.Paste (ppPasteEnhancedMetafile)
Set wordInlineShape = wordDoc.Inlineshapes(pagenumber).LockAspectRatio = msoFalse
wordInlineShape.Height = 735
wordInlineShape.Width = 540
Application.Wait (Now + TimeValue("0:00:03"))

pagenumber = pagenumber + 1
*loop continues*

Upvotes: 1

Related Questions