从word文件中删除空白页

Question

我正在使用 word 对象来引用 word 文档。我正在将一些图像复制到每一页并将 150 多页的 word 文件转换为 PDF。

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

将第一页添加到我正在使用的那个 word 文件

wordapp.documents.Add

要添加下一页，我使用下一行中的代码，

wordapp.ActiveDocument.Sections.Add

以上代码不会在word文件中插入任何空白页，并且可以成功将其转换为pdf。

供您参考，

我的电脑环境是Windows10，Office 2013。但是当我在另一台电脑上使用它时，它会引入空白页。这里 Windows 10 和 Office 2010。

完整代码在这里。页码指定我们是否第一次尝试创建 word 文档。所以只添加嵌套时间页面

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*

Answer 1

您遇到困难的原因是 Sections.Add 不是将新页面插入 Word 文档的方法。一个 Word "Section" 定义了一组页面布局格式，例如纵向与横向、不同的边距设置、不同的页眉和页脚等。

有多种"section breaks"，其中一种不创建新页面。如果不指定分页符的类型，Word 将使用本地默认设置（可以是 user-determined）。所以可能在一台机器上 "Next Page" 是默认值，而在另一台机器上 "Continuous".

插入新页面的正确方法是

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

此外，您的代码效率低下且不准确。与 Excel 一样，最好使用底层对象，尤其是 Range 对象。

这里有一些建议：

'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*

从word文件中删除空白页

remove blank pages from word file

excel

vba

ms-office