BarCode 39 in Office-Dokumenten

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

BarCode 39 in Office-Dokumenten

#1

Beitrag von d'r Bastler »

Moin allerseits,

in einer uralt-Version meiner tested SDK (abgestaubtes Sudoku) hatte ich mal einen Code vorgestellt, der Zeichenfolgen (dort geht es um eine 10...12-stellige ID) in den klassischen BarCode 39 umwandelt. Inzwischen habe ich das dazu notwendige vielzeilige Shape-bildende Modul entsorgt und durch die Umwandlung per TrueTypeFont ersetzt. Auf DaFont.com gibt es eine Umsetzung, die sogar mit meinem Billigscanner funktioniert. Allerdings nur unter Beachtung eines wichtigen Tipps: Der Barcode braucht zwei * (Sternchen) als Anfangs- bzw. Endezeichen. Um z.B. vbAsteleien2024 umzuwandeln, muss *vbasteleien2024* eingegeben werden. Ergebnis:
Code39.jpg
Bewährt hat sich die Schriftgröße 16, die man mit

Code: Alles auswählen

    Set rng = .Range(Cells(13, 2), Cells(13, 10))
    sBar = "*" & .Cells(11, 5) & "*"
    With rng
        .MergeCells = True                      'BarCode
        .Font.Name = "IDAHC39M Code 39 Barcode" 'TTF
        .Font.Size = 16
        .VerticalAlignment = xlTop
        .HorizontalAlignment = xlCenter
        .Value = sBar
    End With
z.B. so gestalten kann, dass die im Code39 sichtbare ASCII-Zeichenfolge ausgeblendet scheint. Anmerkung zum Cells.Merge: Eigentlich sollte man hier auch die Format-Option Zentriert über Auswahl verwenden. War aber nicht das Thema ;)

Funktioniert überall wo TTFs funktionieren ...

Viel Spaß damit!
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Folgende Benutzer bedankten sich beim Autor d'r Bastler für den Beitrag:
thowe
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: BarCode 39 in Office-Dokumenten

#2

Beitrag von d'r Bastler »

Moin allerseits,

und so wird aus einem Tipp eine Frage: Kann man in XL/OF, Win irgendwie erkennen, ob ein Wert einer Eingabe per Tastatur, Drag 'n Drop ist, oder von einem Hand-Scanner kommt?

...und dies dann einem bestimmten Ziel (Zelle, TextBox, usw.) zuordnen?

Lieben Dank für jede schlaue Idee!

Schöne Grüße
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
knobbi38
Beiträge: 25
Registriert: 20. Okt 2024, 14:15
Hat sich bedankt: 2 Mal
Danksagung erhalten: 19 Mal
Kontaktdaten:

Re: BarCode 39 in Office-Dokumenten

#3

Beitrag von knobbi38 »

Hallo,

Drag und Drop könnte man bei bestimmten Steuerelementen erkennen, aber dann ist schon eine Zuordnung erfolgt. Eine Unterscheidung zwischen Keyboard und Scanner ist meines Wissen nicht möglich, weil der Scanner ja eine Tastatur emuliert.
Es gibt auch USB-Scanner mit einem eigenen Treiber-Modell und einem SDK dazu, ist aber sehr selten.

I.d.R. setzt man de Fokus auf eine Textbox und warte auf die Eingabe, entweder per Tastatur oder Scanner.

Gruß
Ulrich
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: BarCode 39 in Office-Dokumenten

#4

Beitrag von d'r Bastler »

Moin Ulrich,

das ist ja das Lästige an Bastlern: Manchmal mögen die sich nicht an Regeln halten :mrgreen:

Dank für Deine Erläuterung!

lg
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: BarCode 39 in Office-Dokumenten

#5

Beitrag von d'r Bastler »

Moin allerseits,
in einer uralt-Version meiner tested SDK (abgestaubtes Sudoku) hatte ich mal einen Code vorgestellt,
und ihn dann oben unsinnigerweise und vermeintlich einfacher durch die TTF-Variante ersetzt. Das muss ich mal ganz deutlich zurücknehmen!

Der Code funktioniert (in XL) so gut wie die TTF-Lösung - wenn man denn den Tipp mit den Sternchen auch hier beherzigt. BarCode39 benötigt die führenden und schließenden Sternchen * als Escape-Codes. Dann hat diese Version den Vorteil, Barcodes auch ohne den speziellen TTF zu generieren, was die Sache beim Weitergeben von Dateien erheblich vereinfacht.

Der Code ist natürlich nicht auf meinem Mist gewachsen, hat aber für allgemeine Zwecke Potential der Verschlankung. Nach dieser Diät stelle ich ihn gerne -natürlich unter Nennung und mit Dank an den Autor- hier ein.

Schöne Grüße
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: BarCode 39 in Office-Dokumenten

#6

Beitrag von d'r Bastler »

Moin Ulrich,

inzwischen bin ich bezüglich meiner Regelwidrigkeiten um Scanner und Tastatur einen Schritt weiter: Es gibt tatsächlich mit PowerShell ISE eine Möglichkeit eindeutige IDs für PNP-Geräte auszulesen. Das noch per VBA auszulösen und dann das Ergebnis abzufangen, steht aber noch auf der ToDo-Liste für ganz speziell geduldige VBAstelstunden. Allein das Piepsen des Scanners beim Test macht schon mittelmäßig wahnsinnig ...

Schöne Grüße
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Re: BarCode 39 in Office-Dokumenten

#7

Beitrag von d'r Bastler »

Moin allerseits,

und hier nun der etwas verallgemeinerte und verschlankte Code, mit dem sich fantastisch BarCodes39 erzeugen lassen, ohne dazu externe TTFs zu bemühen. www.guenter-muehldorfer.de sei herzlichen Dank!

Den folgenden Code in ein allg. Modul, nicht unbedingt die Zelle A1 ausgewählen (ab C3 geht's besser), den Aufruf über Alt-F8 MakeCode39 starten und schon erfreut einen eine hübsche Schwarz/Weiß-Landschaft, die auf Klick auch dann ihren Wert verrät, wenn man gerade mal keinen Scanner zur Hand hat.

Code: Alles auswählen

Option Explicit
Public sValue As String

Sub MakeCode39()
Dim sName As String, sCode As String
Dim iL As Integer, iT As Integer, iX As Integer, iH As Integer
Dim i As Integer, j As Integer, c As Integer
Dim shp As Shape, aLines()

sValue = InputBox("Ziffern und Text, auch mit Esc-Zeichen, keine Leerzeichen", "BarCode39")
    If Left(sValue, 1) <> "*" Then sValue = "*" & sValue
    If Right(sValue, 1) <> "*" Then sValue = sValue & "*"

iL = ActiveCell.Left - 2: iT = ActiveCell.Top - 2: iX = 2: iH = 25: sName = "BarCode39"
    
With ActiveSheet
    For Each shp In .Shapes
        If shp.Name = sName Then
            shp.Delete
        End If
    Next
    
    For i = 1 To Len(sValue)
        sCode = GetCode(Mid(sValue, i, 1))
        For j = 1 To Len(sCode)
            Set shp = .Shapes.AddShape(msoShapeRectangle, iL, iT, iX, iH)
            iL = iL + iX
            
            If Mid(sCode, j, 1) = 1 Then
                shp.Fill.ForeColor.RGB = RGB(0, 0, 0)
                shp.Line.ForeColor.RGB = RGB(0, 0, 0)
            Else
                shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
                shp.Line.ForeColor.RGB = RGB(255, 255, 255)
            End If
            
            c = c + 1
            ReDim Preserve aLines(1 To c)
            aLines(c) = shp.Name
        Next
    Next

    sValue = Replace(sValue, "*", "")
    Set shp = .Shapes.Range(aLines).group
        shp.Name = sName
        shp.OnAction = "Action"
End With
    
End Sub

Private Sub Action()
    MsgBox "Wert " & sValue, , "Developed by https://guenter-muehldorfer.de/"
End Sub

Private Function GetCode(ByVal Character As String) As String
    Dim sCode As String
    Select Case UCase(Character)
        Case "*"
            sCode = "1001011011010"
        Case "0"
            sCode = "1010011011010"
        Case "1"
            sCode = "1101001010110"
        Case "2"
            sCode = "1011001010110"
        Case "3"
            sCode = "1101100101010"
        Case "4"
            sCode = "1010011010110"
        Case "5"
            sCode = "1101001101010"
        Case "6"
            sCode = "1011001101010"
        Case "7"
            sCode = "1010010110110"
        Case "8"
            sCode = "1101001011010"
        Case "9"
            sCode = "1011001011010"
        Case "A"
            sCode = "1101010010110"
        Case "B"
            sCode = "1011010010110"
        Case "C"
            sCode = "1101101001010"
        Case "D"
            sCode = "1010110010110"
        Case "E"
            sCode = "1101011001010"
        Case "F"
            sCode = "1011011001010"
        Case "G"
            sCode = "1010100110110"
        Case "H"
            sCode = "1101010011010"
        Case "I"
            sCode = "1011010011010"
        Case "J"
            sCode = "1010110011010"
        Case "K"
            sCode = "1101010100110"
        Case "L"
            sCode = "1011010100110"
        Case "M"
            sCode = "1101101010010"
        Case "N"
            sCode = "1010110100110"
        Case "O"
            sCode = "1101011010010"
        Case "P"
            sCode = "1011011010010"
        Case "Q"
            sCode = "1010101100110"
        Case "R"
            sCode = "1101010110010"
        Case "S"
            sCode = "1011010110010"
        Case "T"
            sCode = "1010110110010"
        Case "U"
            sCode = "1100101010110"
        Case "V"
            sCode = "1001101010110"
        Case "W"
            sCode = "1100110101010"
        Case "iL"
            sCode = "1001011010110"
        Case "iT"
            sCode = "1100101101010"
        Case "Z"
            sCode = "1001101101010"
        Case "-"
            sCode = "1001010110110"
        Case "."
            sCode = "1100101011010"
        Case " "
            sCode = "1001101011010"
        Case "$"
            sCode = "1001001001010"
        Case "/"
            sCode = "1001001010010"
        Case "+"
            sCode = "1001010010010"
        Case "%"
            sCode = "1010010010010"
        Case Else
            sCode = ""
    End Select
    
    GetCode = sCode
End Function
Viel Spaß damit!
Folgende Benutzer bedankten sich beim Autor d'r Bastler für den Beitrag:
knobbi38
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Antworten

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste