I added a function in the excel visual basic like below which converts the string in to the bar code got this from the blog
Public Function Code128(SourceString As String)
Dim Counter As Integer
Dim CheckSum As Long
Dim mini As Integer
Dim dummy As Integer
Dim UseTableB As Boolean
Dim Code128_Barcode As String
If Len(SourceString) > 0 Then
'Check for valid characters
For Counter = 1 To Len(SourceString)
Select Case Asc(Mid(SourceString, Counter, 1))
Case 32 To 126, 203
Case Else
MsgBox "Invalid character in barcode string." & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
Code128 = ""
Exit Function
End Select
Next
Code128_Barcode = ""
UseTableB = True
Counter = 1
Do While Counter <= Len(SourceString)
If UseTableB Then
'Check if we can switch to Table C
mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
GoSub testnum
If mini% < 0 Then 'Use Table C
If Counter = 1 Then
Code128_Barcode = Chr(205)
Else 'Switch to table C
Code128_Barcode = Code128_Barcode & Chr(199)
End If
UseTableB = False
Else
If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B
End If
End If
If Not UseTableB Then
'We are using Table C, try to process 2 digits
mini% = 2
GoSub testnum
If mini% < 0 Then 'OK for 2 digits, process it
dummy% = Val(Mid(SourceString, Counter, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
Code128_Barcode = Code128_Barcode & Chr(dummy%)
Counter = Counter + 2
Else 'We haven't got 2 digits, switch to Table B
Code128_Barcode = Code128_Barcode & Chr(200)
UseTableB = True
End If
End If
If UseTableB Then
'Process 1 digit with table B
Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
Counter = Counter + 1
End If
Loop
'Calculation of the checksum
For Counter = 1 To Len(Code128_Barcode)
dummy% = Asc(Mid(Code128_Barcode, Counter, 1))
dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
If Counter = 1 Then CheckSum& = dummy%
CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103
Next
'Calculation of the checksum ASCII code
CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
'Add the checksum and the STOP
Code128_Barcode = Code128_Barcode & Chr(CheckSum&) & Chr$(206)
End If
Code128 = Code128_Barcode
Exit Function
testnum:
'if the mini% characters from Counter are numeric, then mini%=0
mini% = mini% - 1
If Counter + mini% <= Len(SourceString) Then
Do While mini% >= 0
If Asc(Mid(SourceString, Counter + mini%, 1)) < 48 Or Asc(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
mini% = mini% - 1
Loop
End If
Return
End Function
I need to call this function in the macro I am creating for formating the cells. I am new to macros and the vba function. Now I dont know how to call these function inside macros and pass the column A in to the function in a loop.So all the values in column A is converted in to bar codes
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
For Each Target In Range(Cells(1, 1), Cells(65536, 1).End(xlUp))
If Target <> "" Then
With Range(Target, Target.Offset(0, 11))
.WrapText = True
End With
End If
Next
I'm not entirely sure what you mean by "set the font to Code128" so this is my best guess
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
For Each Target In Range("A1", Range("A" & Rows.Count).End(xlUp))
If Target.Value <> vbNullString Then
Target.Value = Code128(Target.Value)
Target.Resize(, 12).WrapText = True
End If
Next