Barcode mit Excel-Bordmitteln erstellen

Sollen Dokumente maschinenlesbar sein, führt in der Regel kein Weg an Barcodes vorbei. Oftmals werden für die Erstellung dieser Barcodes spezielle Schriftarten verwendet, die den darzustellenden Text umwandeln. Doch gerade wenn man Dokumente mit eingebetteten Barcodes weitergeben möchte, kann man nicht sicher sein, dass die benötigte Schriftart auch auf dem Zielrechner vorhanden ist. Deshalb möchten wir Ihnen hier zeigen, wie Sie einen Code39 Barcode nur mit Excel Bordmitteln erstellen können ohne irgendetwas zusätzlich installieren zu müssen.

Der Code39 ist einer der ältesten Barcodes. Wir haben ihn hier als Beispiel genommen, weil sein Aufbau sehr einfach ist und der VBA-Code hierfür deshalb hoffentlich entsprechend leicht verständlich ist.

Die zweite Prozedur getCode() ist für das Verständnis nicht ganz so wichtig, da sie nur die Aufgabe hat, ein Mapping zwischen einem einzelnen Zeichen und den benötigten schwarzen und weißen Balken zu liefern. Viel wichtiger ist die Frage, wie diese Balken gezeichnet werden können. Dazu wird der darzustellende Text ggf. zuerst um das im Barcode definierte Start- und Stopzeichen (*) ergänzt, falls es nicht mit übergeben wurde. Dann wird der Text Zeichen für Zeichen durchgegangen und mit Hilfe der Mapping-Funktion wird die erforderliche Abfolge von weißen und schwarzen Balken ermittelt (1 = schwarzer Balken, 0 = weißer Balken).

Dann werden in einer weiteren Schleife dieser Mapping-Wert Ziffer für Ziffer abgearbeitet und jeweils ein Shape-Element eingefügt. Abhängig vom Wert der aktuellen Ziffer wird dieses Shape dann schwarz oder weiß eingefärbt und die aktuelle Position wird um die Breite eines Balkens weiter geschoben.

Die Namen aller so angelegter Shapes werden zudem in einem Array gespeichert. Nachdem das letzte Zeichen fertig gestellt wurde, wird dieses Array verwendet um die einzelnen Shapes zu einem Gesamt-Shape zu gruppieren. Diesem wird dann auch der Name gegeben, den die Prozedur zwingend als Parameter erwartet. Dadurch wird es möglich, bei einer Aktualisierung des Barcodes Position und Größe des alten Barcodes auszulesen, bevor er gelöscht und neu gezeichnet wird.

Zur Verwendung des Codes kann man zum Beispiel im Worksheet_Changed Event den Wert einer Zelle an die Prozedur übergeben:

Private Sub Worksheet_Change(ByVal Target As Range)
    paintCode39 Me.Cells(6, 1), Me, "Barcodetest", 2
End Sub

Wenn der Barcode noch nicht existiert, wird er an der Position X = 100 Y = 100 auf dem entsprechenden Arbeitsblatt angelegt. Ist dort bereits ein Shape mit dem gleichen Namen (in diesem Beispiel „Barcodetest“) vorhanden, wird es durch den aktuellen Barcode ersetzt. Der letzte Parameter ScaleFactor dient schließlich als eine Art Zoom-Faktor und gibt an, mit welcher Auflösung der Barcode erstellt werden soll (= Breite eines einzelnen schmalen Balkens). Hier finden Sie eine Beispieldatei mit dem Quellcode sowie einem Arbeitsblatt, das die Verwendung exemplarisch zeigt.

Quellcode:

Option Explicit

' -----------------------------------------------------------------
' paintCode39
' Prozedur zum erstellen von Code39 Barcodes mit Excel Bord-Mitteln
' -----------------------------------------------------------------
' Autor: Günter Mühldorfer
' Copyright: cboden softwareentwicklung
' Fabriciusstr. 14
' 65933 Frankfurt am Main
' ------------------------------------------------------------------
' Parameter
' - Value: Wert, der als Barcode angezeigt werden soll
' - Sheet: Arbeitsblatt, auf dem der Barcode gezeichnet werden soll
' - Name: Name der zu erstellenden Barcode-Grafik. Der Name muss
' innerhalb des Arbeitsblattes eindeutig sein
' - ScaleFactor: Faktor für Größenanpassung.
' -------------------------------------------------------------------
Public Sub paintCode39(ByVal Value As String, _
ByRef Sheet As Worksheet, _
ByVal Name As String, _
ByVal ScaleFactor As Integer)
' Variable anlegen
Dim X As Integer
Dim Y As Integer
Dim Height As Integer
Dim i As Integer
Dim j As Integer
Dim sh As Shape
Dim code As String
Dim varArray() As Variant
Dim iCount As Integer

' Positionsvariable initialisieren
X = 100
Y = 100
Height = 50

' ggf. Start- und Stopzeichen zum anzuzeigenden Wert hinzufügen
If Left(Value, 1) <> "*" Then Value = "*" & Value
If Right(Value, 1) <> "*" Then Value = Value & "*"

' Ermitteln, ob sich bereits einen alte Version des Barcodes
' auf dem Arbeitsblatt befindet.
For Each sh In Sheet.Shapes
If sh.Name = Name Then
' alte Barcode-Grafik gefunden. Default-Werte für
' Positionsvariable überschreiben
X = sh.Left
Y = sh.Top
Height = sh.Height

' alte Grafik löschen
sh.Delete

' Schleife beenden
Exit For
End If
Next

' Mit Schleife den anzuzeigenden Wert zeichenweise durchgehen
For i = 1 To Len(Value)

' aktuelles Zeichen gemäß Mapping-Tabelle kodieren
' Beispiel: A wird zu 1101010010110
code = getCode(Mid(Value, i, 1))

' Prüfen, ob gültige Kodierung gefunden wurde.
If code = "" Then
MsgBox "Barcode-Erstellung abgebrochen.", _
vbCritical, _
"Undefiniertes Zeichen."
Exit For
End If

' den Kode Balken für Balken durchgehen
For j = 1 To Len(code)
' neues Shape-Objekt anlegen mit ScalFactor-Breite anlegen
Set sh = Sheet.Shapes.AddShape(msoShapeRectangle, _
X, _
Y, _
ScaleFactor, _
Height)

' X-Position um Breite des ScalFactor weiterschieben
X = X + ScaleFactor

' abhängig vom aktuellen Kode Shape schwarz oder weiß färben
If Mid(code, j, 1) = 1 Then
' Kode = 1 --> schwarzer Balken
sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
sh.Line.ForeColor.RGB = RGB(0, 0, 0)
Else
' Kode = 0 --> weißer Balken
sh.Fill.ForeColor.RGB = RGB(255, 255, 255)
sh.Line.ForeColor.RGB = RGB(255, 255, 255)
End If

' Balken in Array für spätere Gruppierung hinzufügen
iCount = iCount + 1
ReDim Preserve varArray(1 To iCount)
varArray(iCount) = sh.Name
Next
Next
group:
' Alle bisher angelegten Balken zu einer einzelnen Grafik gruppieren
Set sh = Sheet.Shapes.Range(varArray).group

' gruppierte Grafik benennen
sh.Name = Name
End Sub

' -----------------------------------------------------------------
' getCode
' Mapping-Funktion zum Umwandeln eines gegebenen Zeichens in eine
' Kodieren zur Generierung eines Code39 Barcode-Elements
' -----------------------------------------------------------------
' Autor: Günter Mühldorfer
' Copyright: cboden softwareentwicklung
' Fabriciusstr. 14
' 65933 Frankfurt am Main
' ------------------------------------------------------------------
' Parameter
' - Character: das zu kodierende Zeichen
' -------------------------------------------------------------------
' Rückgabewert: Kodierung gemäß Code39
' 1 = schwarzer Balken
' 0 = weißer Balken
' Für einen breiten Balken werden zwei gleichfarbige Balken
' hintereinander kodiert.
' Bei einem nicht im Code39 definierten Zeichen gibt die Funktion
' eine leere Zeichenfolge zurück.
' -------------------------------------------------------------------
Private Function getCode(ByVal Character As String) As String
Dim code As String
Select Case UCase(Character)
Case "*"
code = "1001011011010"
Case "0"
code = "1010011011010"
Case "1"
code = "1101001010110"
Case "2"
code = "1011001010110"
Case "3"
code = "1101100101010"
Case "4"
code = "1010011010110"
Case "5"
code = "1101001101010"
Case "6"
code = "1011001101010"
Case "7"
code = "1010010110110"
Case "8"
code = "1101001011010"
Case "9"
code = "1011001011010"
Case "A"
code = "1101010010110"
Case "B"
code = "1011010010110"
Case "C"
code = "1101101001010"
Case "D"
code = "1010110010110"
Case "E"
code = "1101011001010"
Case "F"
code = "1011011001010"
Case "G"
code = "1010100110110"
Case "H"
code = "1101010011010"
Case "I"
code = "1011010011010"
Case "J"
code = "1010110011010"
Case "K"
code = "1101010100110"
Case "L"
code = "1011010100110"
Case "M"
code = "1101101010010"
Case "N"
code = "1010110100110"
Case "O"
code = "1101011010010"
Case "P"
code = "1011011010010"
Case "Q"
code = "1010101100110"
Case "R"
code = "1101010110010"
Case "S"
code = "1011010110010"
Case "T"
code = "1010110110010"
Case "U"
code = "1100101010110"
Case "V"
code = "1001101010110"
Case "W"
code = "1100110101010"
Case "X"
code = "1001011010110"
Case "Y"
code = "1100101101010"
Case "Z"
code = "1001101101010"
Case "-"
code = "1001010110110"
Case "."
code = "1100101011010"
Case " "
code = "1001101011010"
Case "$"
code = "1001001001010"
Case "/"
code = "1001001010010"
Case "+"
code = "1001010010010"
Case "%"
code = "1010010010010"
Case Else
code = ""
End Select

getCode = code
End Function

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.