Tipps&Tricks

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