Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

https://github.com/JonasHeidelberg/barcode-vba-macro-only

https://stackoverflow.com/questions/16143331/generating-2d-pdf417-or-qr-barcodes-using-excel-vba/31663859#31663859

Import barcody.bas

"Calling Macro"

Public Const GraphicalMode As Integer = 1
Public Const FontMode As Integer = 0

Public Const QRCode As Integer = 51
Public Const EAN8 As Integer = 1
Public Const UPCA As Integer = 1
Public Const UPCE As Integer = 1
Public Const TwoOfFive As Integer = 2
Public Const Code39 As Integer = 39
Public Const DataMatrix As Integer = 50

Public Const LowErrorCorrection As Integer = 0
Public Const MediumErrorCorrection As Integer = 1
Public Const QuartileErrorCorrection As Integer = 2
Public Const HighErrorCorrection As Integer = 3
Public Sub Barcode_Generator(control As IRibbonControl)
 Call Barcode_Generator_Sub
End Sub
Public Sub Barcode_Generator_Sub()
'=EncodeBarcode(CELL("SHEET"),CELL("ADDRESS"),A2,39,1,0,2)
'https://stackoverflow.com/questions/16143331/generating-2d-pdf417-or-qr-barcodes-using-excel-vba/31663859#31663859

Dim BarCodeWS As Worksheet
WorksheetCreateDelIfExists ("BarCodes")
Set BarCodeWS = Worksheets("BarCodes")
BarCodeWS.Activate

Dim UIMode As Integer, BarCodeMode As Integer, ErrorLevel As Integer
UIMode = GraphicalMode
BarCodeMode = Code39
ErrorLevel = LowErrorCorrection

Dim BarCodeText As String, BarCodeTextCellAsStr As String, InsertBarcodeImageCell As Range

'BarCodeText = "Hello World"
BarCodeText = Application.InputBox("Enter BarCode Text")
BarCodeText = TrimmedStr(BarCodeText)
BarCodeTextCellAsStr = "B4"
Set InsertBarcodeImageCell = Range("B5")

Range(BarCodeTextCellAsStr).Value = BarCodeText
InsertBarcodeImageCell.Formula = "=EncodeBarcode(CELL(""SHEET""), CELL(""ADDRESS"")," & BarCodeTextCellAsStr & ", " & BarCodeMode & "," & UIMode & ", " & ErrorLevel & ", 2)"
Debug.Print "BarCodeTextCellAsStr = " & BarCodeTextCellAsStr & " BarCodeMode = " & BarCodeMode & " UIMode = " & UIMode & " ErrorLevel = " & ErrorLevel & " 2 = 2"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
 .Orientation = xlPortrait
 .FitToPagesWide = 1
 .FitToPagesTall = True
End With
Application.PrintCommunication = True

End Sub
  • No labels