Eigene Funktion soll berechnen und formatieren

Public Function EAN13_Aktuelle_Uhrzeit_darstellen() As String
Application.Volatile
Call Zelle_Formatieren(ActiveCell.Row, ActiveCell.Column)
EAN13_Aktuelle_Uhrzeit_darstellen = EAN_Barcode_für_Anzeige(Format(Now, "DDMMYYhhmmss"))
End Function

Public Sub Zelle_Formatieren(Zeile As Integer, Spalte As Integer)

' die Zelle, in der die Funktion steht, mit der richtigen Schriftart und -größe einstellen

Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).Select

If Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).Formula = "= _

EAN13_Aktuelle_Uhrzeit_darstellen()" Then

'        Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).Font.Name = "Code EAN13"

'        Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte)).Font.Size = 48

With Selection.Font

.Name = "Code EAN13"

.Size = 11

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

With Selection.Font

.Name = "Code EAN13"

.Size = 48

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

Application.ScreenUpdating = True

End If

End Sub

Public Function EAN_Barcode_für_Anzeige(Barcodenummer As String) As String
' Liefert den richtigen Zeichensatz für die übergebene Barcodenr.
' Anhand der Länge wird ggf. auch noch eine Prüfziffer angehängt.
' Fehlermeldung werden angezeigt.
' Die Barcodenr. Ist dann schon in der Anzeige eingebaut und muß nicht noch separat  _
dargestellt werden
' Fonts: Q:\BF\BF-V\BF-V_ALL\Word Vorlagen Neu\Excel Addons\Fonts
Select Case Len(Barcodenummer)
Case 7
EAN_Barcode_für_Anzeige = EAN8$(Barcodenummer)
Case 8
If Right(Barcodenummer, 1) = Right(EAN_Barcode_Prüfziffer_berechnen(Mid( _
Barcodenummer, 1, Len(Barcodenummer) - 1)), 1) Then
EAN_Barcode_für_Anzeige = EAN8$(Mid(Barcodenummer, 1, Len(Barcodenummer) - 1))
Else
MsgBox "Die übergebene Barcodenr. " & Barcodenummer & " ergibt eine andere Prü  _
_
fziffer, als die, die in der übergebenen Barcodenr. Enthalten ist. Bitte überprüfen Sie Ihre  _
Barcodenr."
End If
Case 12
EAN_Barcode_für_Anzeige = EAN13$(Barcodenummer)
Case 13
If Right(Barcodenummer, 1) = Right(EAN_Barcode_Prüfziffer_berechnen(Mid( _
Barcodenummer, 1, Len(Barcodenummer) - 1)), 1) Then
EAN_Barcode_für_Anzeige = EAN13$(Mid(Barcodenummer, 1, Len(Barcodenummer) - 1))
Else
MsgBox "Die übergebene Barcodenr. " & Barcodenummer & " ergibt eine andere Prü  _
_
fziffer, als die, die in der übergebenen Barcodenr. Enthalten ist. Bitte überprüfen Sie Ihre  _
Barcodenr."
End If
Case Else
MsgBox "Ihre Eingabe " & vbCrLf & vbCrLf & "ist leider nicht 7 bzw. 12 stellig. "
End Select
End Function

Public Function EAN_Barcode_Prüfziffer_berechnen(zahl As Variant) As Variant

' Berechnet für die übergebene Barcodenr. die Prüfziffer und liefert die kpl. Barcodenr.  _

zurück.

' Variablen deklarieren

Dim i As Integer

Dim ziffer As Integer

Dim temp As Variant

temp = zahl

' Standardwert festlegen

EAN_Barcode_Prüfziffer_berechnen = 0

If zahl / 10 ^ 12 > 1 Then

EAN_Barcode_Prüfziffer_berechnen = zahl ' EAN_Barcode_Prüfziffer_berechnen ist bereits  _

13 stellig

Else

For i = 1 To 12

zahl = Int(zahl)

zahl = zahl / 10

ziffer = 10 * (zahl - Int(zahl))

EAN_Barcode_Prüfziffer_berechnen = EAN_Barcode_Prüfziffer_berechnen + ziffer * (1 +  _

2 * (i Mod 2))

Next

EAN_Barcode_Prüfziffer_berechnen = 10 * temp + (10 - (EAN_Barcode_Prüfziffer_berechnen  _

Mod 10))

End If

End Function

Public Function EAN13$(chaine$)

' Liefert für den EAN13 - Barcode den entsprechenden Anzeigecode

' Variablendeklaration

Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean

' Standardwert festlegen

EAN13$ = ""

' Prüfen, ob es sich um einen EAN13-Barcode handelt

If Len(chaine$) = 12 Then

' Prüfen, ob es sich bei dem übergebenen Wert nur um Zahlen handelt

For i% = 1 To 12

If Asc(Mid$(chaine$, i%, 1))  57 Then

' Wenn es keine Zahl war, dann ist i% = 0

i% = 0

Exit For

End If

Next

' Wenn es nur Zahlen waren, dann den EAN13-Barcode-String berechnen

If i% = 13 Then

' Die Prüfsumme berechnen

For i% = 12 To 1 Step -2

checksum% = checksum% + Val(Mid$(chaine$, i%, 1))

Next

checksum% = checksum% * 3

For i% = 11 To 1 Step -2

checksum% = checksum% + Val(Mid$(chaine$, i%, 1))

Next

chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10

'Le premier chiffre est pris tel quel, le deuxieme vient de la table A

'The first digit is taken just as it is, the second one come from Table A

CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))

first% = Val(Left$(chaine$, 1))

For i% = 3 To 7

tableA = False

Select Case i%

Case 3

Select Case first%

Case 0 To 3

tableA = True

End Select

Case 4

Select Case first%

Case 0, 4, 7, 8

tableA = True

End Select

Case 5

Select Case first%

Case 0, 1, 4, 5, 9

tableA = True

End Select

Case 6

Select Case first%

Case 0, 2, 5, 6, 7

tableA = True

End Select

Case 7

Select Case first%

Case 0, 3, 6, 8, 9

tableA = True

End Select

End Select

If tableA Then

CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))

Else

CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))

End If

Next

CodeBarre$ = CodeBarre$ & "*"   'Ajout separateur central / Add middle Separator

For i% = 8 To 13

CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))

Next

CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin / Add end mark

EAN13$ = CodeBarre$

End If

End If

End Function