Merge Barcode (B-Coder and Word)

The following is a subroutine for Word 97/2000 that searches through a document looking for any text with the style “barcode”. If it finds any, it converts the text to a barcode.

 Sub MergeBarCodes()
  'run B-Coder Minimized
  Shell "C:B-CODER3B-CODER.EXE", 6
  ' Note: make sure that the path for B-Coder is correct in the above command
  
  ' open DDE channel to B-Coder
  Chan = DDEInitiate("B-Coder", "System") 
  
  ' initialize B-Coder here- send dde commands to set up Bar Codes
  ' DDEExecute Chan, "[Code128]" ' tell B-Coder to use Code 128
  ' DDEExecute Chan, "[messagewarnings=off]" ' turn off warning messages
  ' DDEExecute Chan, "[printwarnings=off]"
  ' DDEExecute Chan, "[height=.5]" ' set bar code height
  
  On Error GoTo bye ' quit if an error occurs
  Set MyRange = Selection ' define a range object
  MyRange.SetRange Start:=ActiveDocument.Content.Start, _
    End:=ActiveDocument.Content.End
  
  ' set the range to start at the top of the document and end at the bottom
  While 1 = 1 ' loop forever
  With MyRange.Find ' set Find object properties
    .Forward = True  ' search forward
    .Wrap = wdFindStop  ' stop at end of document
    .Style = "barcode"  ' look for style "barcode"
    .Execute ' do it now
  End With
  
  If MyRange.Find.Found = False Then GoTo bye ' quit if style not found
  
  BCData$ = Selection.Text ' otherwise get bar code data
  
  If Right$(BCData$, 1) = Chr$(13) Then
  ' Remove the carriage return at the end of the selected text
    BCData$ = Left$(BCData$, Len(BCData$) - 1)
  End If
  
  'Create the bar code
  DDEExecute Chan, "[BARCODE=" + BCData$ + "]"

  ' Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove
  ' to put the bar code on the line below the text, un-comment the above line
  
  MyRange.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
  ' paste in the bar code
  Wend ' go find the next one

bye:
  On Error GoTo 0 ' remove error trap
  
  ' tell B-Coder to quit
  DDEExecute Chan, "[Appexit]" 
End Sub

Contact Us