Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1652to1656
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Bild in Userform
31.10.2018 13:18:58
Thomas
Moin zusammen,
ich habe folgenden Code gefunden, welcher mir einen einfachen Barcode als Bild erzeugt.
Diesen würde ich gern an ein UF (z.B. Userform1.Image1) übergeben, bekomme es aber nicht hin.
Vielleicht kann mir ja jemand sagen wie ich die erzeugte Grafik übertragen kann.
Gruß,
Thomas
Code im Arbeitsblatt

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

Code im Modul
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild in Userform
31.10.2018 17:24:14
onur
Du brauchst doch nur z.B. eine Textform auf der Userform mit dem Font irgendeines Barcodes zu formatieren.
AW: Bild in Userform
31.10.2018 18:35:32
Thomas
Danke für die Antwort. Der Code hat den Vorteil, dass er auch funktioniert wenn keine Barcode-Schriftart installiert ist. Daher kann ich es so nicht lösen.
Gruß,
Thomas
AW: Bild in Userform
31.10.2018 20:48:12
onur
Dann solltest du auch mal die Bemerkungen im Code lesen:
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.
Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige