我来帮你解决这个移除Word空白页的问题，结合你用CreateObject("Word.Application")创建文档的场景，这里有几个实用的方案：

方法1：批量清理末尾空白与全文档空白页 #

最常见的空白页成因是文档末尾多余的段落标记，或是分页/分节符导致的空内容页。这个方法会先清理重复的段落标记，再从后往前检查每一页是否为空并删除：

Sub RemoveBlankPages()
    Dim doc As Object
    Set doc = wordapp.ActiveDocument ' 替换为你实际使用的文档对象
    
    ' 第一步：清理连续的段落标记（减少空行导致的空白页）
    doc.Content.Select
    With wordapp.Selection.Find
        .ClearFormatting
        .Text = "^p^p" ' 查找连续的段落标记
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = 1 ' 对应wdFindContinue常量
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .Execute Replace:=2 ' 对应wdReplaceAll常量
    End With
    
    ' 第二步：删除文档末尾的空段落
    Dim lastPara As Object
    Set lastPara = doc.Paragraphs(doc.Paragraphs.Count)
    Do While lastPara.Range.End - lastPara.Range.Start <= 1 ' 判断是否为空段落
        If lastPara.Previous Is Nothing Then Exit Do ' 避免删除第一段落
        lastPara.Range.Delete
        Set lastPara = doc.Paragraphs(doc.Paragraphs.Count)
    Loop
    
    ' 第三步：遍历所有页面，删除完全空白的页
    Dim pageNum As Integer
    Dim pageRange As Object
    ' 从最后一页往前遍历，避免删除后页码混乱
    For pageNum = doc.Content.Information(3) To 1 Step -1 ' 3对应wdNumberOfPagesInDocument
        ' 获取当前页的范围
        Set pageRange = doc.GoTo(What:=1, Which:=1, Name:=pageNum) ' 1对应wdGoToPage和wdGoToAbsolute
        pageRange.End = doc.GoTo(What:=1, Which:=2, Name:=pageNum).End ' 2对应wdGoToNext
        ' 检查页面内容是否为空（去除空格和换行后）
        If Trim(pageRange.Text) = "" Then
            pageRange.Delete
        End If
    Next pageNum
End Sub

方法2：针对分节符导致的空白页 #

你用了Sections.Add添加后续页面，可能会出现分节符后无内容的空白页。这个方法专门清理这类分节：

Sub RemoveSectionBasedBlankPages()
    Dim doc As Object
    Set doc = wordapp.ActiveDocument
    Dim sec As Object
    Dim i As Integer
    
    ' 从最后一个分节往前遍历，防止索引错乱
    For i = doc.Sections.Count To 2 Step -1
        Set sec = doc.Sections(i)
        ' 跳过分节符本身，检查分节内的内容
        Dim secRange As Object
        Set secRange = sec.Range
        secRange.Start = sec.Range.Start + 1
        If Trim(secRange.Text) = "" Then
            sec.Range.Delete ' 删除空分节
        End If
    Next i
End Sub

使用建议 #

你可以在转换PDF之前调用这些方法，比如：

' 先生成你的150页文档...
RemoveBlankPages ' 先移除空白页
' 然后转PDF
wordapp.ActiveDocument.ExportAsFixedFormat _
    OutputFileName:="你的文档路径.pdf", _
    ExportFormat:=17 ' 17对应wdExportFormatPDF常量

内容的提问来源于stack exchange，提问作者Shekhar Nalawade