excel 在VBA中向4x6标签添加更多条形码

nxagd54h 于 2022-12-01 发布在其他

关注(0)|答案(1)|浏览(188)

我正在尝试制作一个4x 6标签，上面有7个code-39条形码，但似乎我的VBA代码覆盖了每个条形码。数据是从Excel文件的单元格B2 - B8中提取的，现在我只能打印2个。此时它只打印B3中的数据，而不是B2和B3。
我也想弄清楚如何让文字显示在A2 - A8栏的每个条形码上方，但还没有到这一步。我试着查找如何做到这一点，但还没有找到很多关于VBA到Word应用程序的信息。以下是我的代码，我真的很感激任何帮助，因为我没有任何VBA的经验。

Sub Button2_Click()
Dim WdApp As Object, WdDoc As Object, StrCd As String, StrCl As String
With ActiveSheet
  StrCd = Chr(34) & .Range("B2").Value & Chr(34)
  StrCl = Chr(34) & .Range("B3").Value & Chr(34)
  
End With
Set WdApp = CreateObject("Word.Application"): Set WdDoc = WdApp.Documents.Add
With WdDoc
  .PageSetup.PageWidth = 288: .PageSetup.PageHeight = 432: .PageSetup.RightMargin = 36: .PageSetup.LeftMargin = 36
  .Fields.Add .Range, -1, "DISPLAYBARCODE " & StrCd & " CODE39 \d \t", False
  .Fields.Add .Range, -1, "DISPLAYBARCODE " & StrCl & " CODE39 \d \t", False
  With .Range
    With .ParagraphFormat
      .LineSpacingRule = 0 'wdLineSpaceSingle
      .SpaceBefore = 0
      .SpaceAfter = 1
    End With
    
    .Copy
  End With
  ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
  .Close False
End With
Set WdDoc = Nothing: WdApp.Quit: Set WdApp = Nothing
End Sub

excel

来源：https://stackoverflow.com/questions/74630240/adding-more-barcodes-to-a-4x6-label-in-vba

1条答案

按热度按时间

epggiuax1#

您可以尝试以下操作：

Option Explicit

Sub Button2_Click()
    Const PER_ROW As Long = 3 '# of labels per row in layout
    Dim WdApp As Object, WdDoc As Object, StrCd As String, StrCl As String
    Dim c As Range, wsData As Worksheet, wsLabel As Worksheet, v, i As Long
    
    'set up a Word doc for generating the barcodes
    Set WdApp = CreateObject("Word.Application")
    WdApp.Visible = True
    Set WdDoc = WdApp.Documents.Add
    With WdDoc.PageSetup
        .PageWidth = 288
        .PageHeight = 432
        .RightMargin = 36
        .LeftMargin = 36
    End With
    
    Set wsData = ThisWorkbook.Worksheets("Label Data") 'data for labels on this sheet
    Set wsLabel = ThisWorkbook.Worksheets("Label")     'labels created on this sheet
    
    For Each c In wsData.Range("B2:B9").Cells
        v = Trim(c.Value)
        If Len(v) > 0 Then
            i = i + 1
            With WdDoc.Fields.Add(WdDoc.Range, -1, "DISPLAYBARCODE " & v & _
                                   " CODE39 \d \t", False)
                .Copy
                If Not PasteWithRetry(wsLabel) Then 'make sure the paste succeeds
                    MsgBox "Paste failed!"
                    Exit For
                End If
                .Delete
            End With
            With wsLabel.Shapes(wsLabel.Shapes.Count) 'get the pasted shape
                .Top = Fix((i - 1) / PER_ROW) * 100    '...and position it
                .Left = ((i - 1) Mod PER_ROW) * 220
            End With
        End If
   Next c
    
   WdDoc.Close False
   WdApp.Quit
End Sub

'Pasting pictures in a loop is often unreliable, so
'  this tries multiple times before giving up...
'Returns True if paste was successful
Function PasteWithRetry(ws As Worksheet) As Boolean
    Dim n As Long, pasted As Boolean
    For n = 1 To 10               'try 10 times to paste
        On Error Resume Next      'ignore any paste error
        ws.PasteSpecial Format:="Picture (Enhanced Metafile)", _
                                Link:=False, DisplayAsIcon:=False
        pasted = (Err.Number = 0) 'no error = pasted OK
        On Error GoTo 0           'stop ignoring errors
        If pasted Then
            PasteWithRetry = True
            Exit Function   'exit if pasted OK
        End If
        DoEvents
    Next n
End Function

赞(0）回复(0）举报 2022-12-01

我来回答

excel 在VBA中向4x6标签添加更多条形码

1条答案

相关问题

热门标签

最新问答