VBA生成Word条码标签遇问题：无法分页与CODE128条码对齐异常求助

我编写了一段VBA代码，用于从Excel读取数据生成带CODE128条码的Word标签，但运行后出现两个问题：

• 无法为每个Excel单元格内容生成独立页面
• 生成的CODE128条码无法实现水平与垂直居中对齐

原代码如下：

Sub CreateBarcode4()
    ' Declare variables
    Dim ws As Worksheet
    Dim wd As Object
    Dim doc As Object
    Dim rng As Range
    Dim cell As Range
    Dim barcode As Object
    Dim text As String
    
    ' Set the Excel sheet to read values from
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new Word document
    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    Set doc = wd.Documents.Add
    
    ' Set the page format to 10cm x 5cm
    With doc.PageSetup
        .PaperSize = wdPaperCustom
        .PageWidth = CentimetersToPoints(10)
        .PageHeight = CentimetersToPoints(5)
        .Orientation = wdOrientLandscape
        .VerticalAlignment = wdAlignVerticalCenter 'Added to vertically align the content of the page
    End With
    
    ' Set the range to read values from
    Set rng = ws.Range("A1", ws.Range("A" & ws.Rows.Count).End(xlUp))
    
    ' For each non-empty cell in the range
    For Each cell In rng
        If cell.Value <> "" Then
            ' Insert a new page in the Word document
            doc.Range.InsertBreak Type:=wdPageBreak
            ' Add the text as the result of the field
            text = "DisplayBarcode " & Chr(34) & cell.Value & Chr(34) & " CODE128 \t"
            ' Add the field to the end of the document
            doc.Fields.Add Range:=doc.Range(doc.Range.End - 1), Type:=wdFieldEmpty, Text:=text, PreserveFormatting:=False
            ' Modify the alignment
            doc.Paragraphs(doc.Paragraphs.Count).Alignment = 1 ' wdAlignParagraphCenter
            ' Modify to hide field codes
            wd.ActiveWindow.View.ShowFieldCodes = False
        End If
    Next cell
End Sub

条码显示异常截图：

问题解决与修改后的代码 #

关键问题分析

1. 独立页面问题：原代码每次循环先插入分页符，导致第一个条码被推到第二页，且分页逻辑会造成页面混乱。需要调整分页符的插入时机，仅在非第一个单元格前插入分页符。
2. 居中对齐问题：仅设置段落水平居中不够，还需要清除段落的默认边距（段前/段后间距），确保条码所在段落没有多余空白，同时配合页面垂直对齐实现整体居中。

修改后的代码：

Sub CreateBarcode_Fixed()
    Dim ws As Worksheet
    Dim wd As Object
    Dim doc As Object
    Dim rng As Range
    Dim cell As Range
    Dim text As String
    Dim isFirstCell As Boolean
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 创建Word应用与文档
    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    Set doc = wd.Documents.Add
    
    ' 设置页面格式
    With doc.PageSetup
        .PaperSize = 7 ' wdPaperCustom
        .PageWidth = CentimetersToPoints(10)
        .PageHeight = CentimetersToPoints(5)
        .Orientation = 1 ' wdOrientLandscape
        .VerticalAlignment = 1 ' wdAlignVerticalCenter
        .TopMargin = CentimetersToPoints(0)
        .BottomMargin = CentimetersToPoints(0)
        .LeftMargin = CentimetersToPoints(0)
        .RightMargin = CentimetersToPoints(0)
    End With
    
    Set rng = ws.Range("A1", ws.Range("A" & ws.Rows.Count).End(xlUp))
    isFirstCell = True
    
    For Each cell In rng
        If cell.Value <> "" Then
            ' 非第一个单元格前插入分页符
            If Not isFirstCell Then
                doc.Range.InsertBreak Type:=7 ' wdPageBreak
            End If
            
            text = "DisplayBarcode " & Chr(34) & cell.Value & Chr(34) & " CODE128 \t"
            ' 插入条码字段
            doc.Fields.Add Range:=doc.Range, Type:=0, Text:=text, PreserveFormatting:=False
            
            ' 设置段落格式：水平居中+清除边距
            With doc.Paragraphs(doc.Paragraphs.Count)
                .Alignment = 1 ' wdAlignParagraphCenter
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LineSpacingRule = 0 ' wdLineSpaceSingle
            End With
            
            wd.ActiveWindow.View.ShowFieldCodes = False
            isFirstCell = False
        End If
    Next cell
End Sub

修改说明

• 用isFirstCell标记控制分页符插入，避免第一个条码前出现空页面
• 清除页面边距（上下左右设为0），配合页面垂直对齐，确保条码在页面内居中
• 给条码所在段落清除段前/段后间距，避免多余空白影响垂直居中
• 使用数值替代Word常量（因为是Late Binding，避免未引用Word库导致的错误）

内容的提问来源于stack exchange，提问作者Massimo Griffani