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

11 Kommentare zu „Barcode mit Excel-Bordmitteln erstellen

    1. Guten Tag,

      grundsätzlich geht es ähnlich auch mit allen Barcodes, die auf dem Code128 aufbauen (wie dem GS1-128). Allerdings ist dieser auf Grund seiner variablen Strichbreite etwas komplexer in der Implementierung – aber immer noch machbar mit Excel Bordmitteln.

  1. Hallo,
    danke für den Code … konnte ich sehr gut gebrauchen. Allerdings war es
    für mich sinnvoller, das Ganze als Formel verwenden zu können.
    Das von mir angepasste Machwerk zu eurer Verwendung.

    Public Function Code39(ByVal Rng As Range, _
    Optional ByVal ScaleFactor As Double = 2) As String
    ' Variable anlegen
    Dim X As Double
    Dim Y As Double
    Dim Height As Double
    Dim i As Long
    Dim j As Long
    Dim sh As Shape
    Dim code As String
    Dim varArray() As Variant
    Dim iCount As Integer
    Dim strText As String

    strText = Rng.text

    ' Positionsvariable initialisieren
    X = Application.Caller.Left + 3
    Y = Application.Caller.Top + 3
    Height = Application.Caller.Height - 6

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

    ' Ermitteln, ob sich bereits einen alte Version des Barcodes
    ' auf dem Arbeitsblatt befindet.
    For Each sh In Sheet.Shapes
    If sh.Name = Application.Caller.Address 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(strText)

    ' aktuelles Zeichen gemäß Mapping-Tabelle kodieren
    ' Beispiel: A wird zu 1101010010110
    code = getCode(Mid(strText, 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 ScaleFactor 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

    ' Breite des Barcodes einstellen
    sh.Width = (Application.Caller.Width * 2 - 6)

    ' gruppierte Grafik benennen
    sh.Name = Application.Caller.Address
    sh.Title = Rng.text
    sh.AlternativeText = "Code 39 Barcode, " & Len(strText) & " Characters"
    End Function

    Die Function getCode kann einfach übernommen werden.

    1. Im Prinzip ist das recht einfach. Nachdem man mit dem Zeichnen des Barcodes fertig ist, kennt man ja seine Gesamt-Breite. Dann einfach einen weiteren Shape unterhalb der Balken einfügen (mit jetzt bekannter Breite und gewünschter Zeilenhöhe) und dann den Wert als Text ausgeben. Die Möglichkeit dazu ist im Shape Object etwas versteckt:

      sh.TextFrame.Characters.Text = Value

      1. Danke für die Schnelle antwort wo genau setz ich im Code an. Bin nich si bewandert in VBA über TextFrame bin ich shcon durch google suche gestolpert nur weis ich nicht wie ich das einfüge.

  2. hall bind leide kein VBA Profi.
    1.habe dennoch dazu eine Frage, ist es möglich das ganze für Barcode 128 anzupassen
    2.wie kann man den Barcode mittig in der Zelle ausrichten
    3. wie kann man den zelbezug ändern für den Barcode

    würde mich sehr freuen für mein Projekte diesbezüglich Hilfe zu mein fragen zu erhalten

    1. Hallo.

      zu 1) Grundsätzlich lässt sich auch ein Barcode 128 auf ähnliche Weise erstellen. Allerdings ist das mehr Aufwand, da der Code 128 eine variable Balkenbreite nutzt. Zudem kennt der Barcode 128 drei sog. Codepages, die theoretisch sogar innerhalb eines Barcodes wechseln können. Das macht es insgesamt etwas komplexer und damit aufwändiger.

      zu 2) Das Ausrichten eines Shapes an einer Zelle ist nicht ganz so einfach aber sollte sich irgendwie machen lassen. Müsste ich aber selbst erst ausprobieren

      zu 3) Zellbezug für die Position, an der der Barcode erstellt wird? In der aktuellen Implementierung wird er nicht an einer Zelle ausgerichtet sondern an einer festen Position erstellt. Das Ausrichten sollte möglich sein (siehe zu 2) ), habe ich aber aus Gründen der Vereinfachung des Beispiels nicht macht.

      1. Hallo danke für die Auskunft! Dies war sehr informativ.wehre es möglich ihnen Mal meine Datei zu schicken zwecks Anpassung des Barcode Generator,den ich würde gerne dies in meiner Datei mit aufnehmen wen es machbar ist?

Schreibe einen Kommentar

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