Option Explicit

'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'HINWEIS:
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+ SO KANN MAN sich seine eigene Umwandlungsfunktion zurechtbiegen
'+ z.B. mit folgenden Standards:
'+ ohne Nachkommaanteil
'+ ohne "undeins" Änderung
'+ alles kleingeschrieben
'+ Trennung des Zahlstrings nach max. 34 Zeichen
'+ Trennzeichen "-"
'+ Vorzeichen "+" und "-" ignorieren
'+ "ß" und kein "ss" gewählt
'+ Zeilenbegrenzung mittels "~"
'+ mindestens zwei Zeilen ausgeben (auffüllen mit "~")
'+ minimale Zeilenlänge (bzw "0" für ungesetzt)
'+ (Tipp: die min.Zeilenlänge sollte immer größer als die
'+ max. Stringlänge bei Trennung gewählt werden und
'+ der Rahmenstring sollte dann die Länge 1 nicht überschreiten)
'+ aufgerufen wird jetzt ganz einfach z.B.
'+    =Zahl_in_Wort(A1)
'+ die restlichen Parameter sind hierbei individuell angepaßt
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Public Function Zahl_in_Wort(i As String) As String
      Zahl_in_Wort = Zeilen_einrahmen(inWorten(i, _
                                               0, _
                                               False, _
                                               False, _
                                               True, _
                                               34, _
                                               "-", _
                                               0, _
                                               False), _
                                       "~", True, 36)
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+
'+
'+
'+ inWorten(): wandelt eine Zahl in einen String um
'+
'+
'+
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Public Function inWorten(Eingabezahl As String, _
                         Optional Nachkommaformat = 0, _
                         Optional undtrue = True, _
                         Optional erster_Buchstabe_gross = False, _
                         Optional Silbentrennung_ein = False, _
                         Optional max_Stringlaenge = Null, _
                         Optional Trennzeichen = "-", _
                         Optional Vorzeichenformat = 0, _
                         Optional ss_ein = False) As String

'Zahlen mit mehr als 16 Ziffern (inkl Nachkommaanteil) müssen in der
'Eingabezelle als Text markiert werden (einführendes Hochkomma)
'da sie sonst fehlerhaft dargestellt werden!

'lokale Variablendeklaration
Dim trenne_in_3er_gruppen As Boolean
Dim sgplus As String
Dim sgminus As String
'    von fixen 24 u. 7 auf 66 und 21 geändert
'    max 999 Dekilliarden...usw
Const bereich = 66
Const d_ber = 21
'   Arrays für Zahlstringdefinitionen
Dim e(9) As String
Dim z(13) As String
Dim d(d_ber) As String
'   Array für die einzelnen Ziffern der Eingabezahl
Dim ziffer(bereich) As Integer
'   statt vbnewline wird nur nl=chr$(10) benutzt
Dim nl As String
'   Schleifenvariable;Zähler
Dim sv As Integer
'
Dim my_string As String
Dim i As String
Dim ztemp As String
Dim sgnm As String
Dim Nachkomma As String
Dim Trenner As String
'
Dim Kommastelle As Integer
Dim j As Integer
Dim l As Integer
Dim k As Integer
Dim temp As Integer
Dim th As Integer
Dim tz As Integer
Dim te As Integer
Dim nk_lang As Integer
Dim left_zero As Integer
Dim lv As Integer

On Error Resume Next

'Initialisierung
trenne_in_3er_gruppen = False
nl = Chr$(10)

'IsNull eingefügt, damit im Aufruf auch ";;;<Wert>" ohne Fehler angenommen wird!

'Nachkommaformat
'   =0   ohne Nachkommaanteil
'   =1   mit " und " und Nachkommaanteil
'   =-1  mit " " und Nachkommaanteil
'   =2   mit " und " und Nachkommaanteil wenn > 0
'   =-2  mit " " und Nachkommaanteil wenn > 0
If IsNull(Nachkommaformat) Then Nachkommaformat = 0

'undtrue ändert
'   =true  =1 --> "undeins"
'   =false =0 --> "eins"
If IsNull(undtrue) Then undtrue = True

'erster_Buchstabe_gross=true
'schreibt den Ersten Buchstaben gross auch bei Trennung wird NUR der
'Erste Buchstabe groß geschrieben im Unterschied zu GROSS2()!
If IsNull(erster_Buchstabe_gross) Then erster_Buchstabe_gross = False

'Silbentrennung_ein=true
'dann wird der Ausgabestring wenn möglich bei max_Stringlaenge getrennt
If IsNull(Silbentrennung_ein) Then Silbentrennung_ein = False

'max_Stringlaenge
'fehlt die Variable oder ist NULL gesetzt, dann wird in 3er-Gruppen getrennt
If IsNull(max_Stringlaenge) Then
    trenne_in_3er_gruppen = True
    Silbentrennung_ein = False
    End If
    
'Trennzeicheninitialisierung, wenn nicht schon über optionalen Parameter definiert
If IsNull(Trennzeichen) Then Trennzeichen = "-"

'Vorzeichenformat
'   wie soll ein evtl vorhandenes Vorzeichen behandelt werden?
'   0=         ignorieren
'   1=         beachten, wenn erstes Zeichen im String
'   2=         immer suchen
'   -1 bzw -2= wie oben aber "Plus " und "Minus " vor dem Textstring
If IsNull(Vorzeichenformat) Then Vorzeichenformat = 0

If Vorzeichenformat >= 0 Then
   sgplus = " + "
   sgminus = " - "
   Else
   sgplus = "Plus "
   sgminus = "Minus "
   End If

'ss_ein steuert den Aufruf der Funktion aendere_sz und damit,
'ob "ß" oder "ss" ausgegeben wird?
If IsNull(ss_ein) Then ss_ein = False

'to do list: wie wird ziffer() schon bei der Definition mit Startwert gefüllt?
'Kann hier eigentlich auch wegfallen
For sv = 0 To bereich
 ziffer(sv) = 0
Next sv

'Number defs
e(0) = "null"
e(1) = "ein": e(2) = "zwei": e(3) = "drei"
e(4) = "vier": e(5) = "fünf": e(6) = "sechs"
e(7) = "sieben": e(8) = "acht": e(9) = "neun"
z(10) = "sech" 'Sonderfall für 16
z(13) = "sieb" 'Sonderfall 17

z(1) = "zehn": z(2) = "zwanzig": z(3) = "dreißig"
z(4) = "vierzig": z(5) = "fünfzig": z(6) = "sechzig"
z(7) = "siebzig": z(8) = "achtzig": z(9) = "neunzig"
z(11) = "elf": z(12) = "zwölf"

d(0) = "hundert"
d(1) = "tausend"
d(2) = "million"
d(3) = "milliarde"
d(4) = "billion"
d(5) = "billiarde"
d(6) = "trillion"
d(7) = "trilliarde"
d(8) = "quadrillion"
d(9) = "quadrilliarde"
d(10) = "quintillion"
d(11) = "quintilliarde"
d(12) = "sextillion"
d(13) = "sextilliarde"
d(14) = "septillion"
d(15) = "septilliarde"
d(16) = "oktillion"
d(17) = "oktilliarde"
d(18) = "nonillion"
d(19) = "nonilliarde"
d(20) = "dekillion"
d(21) = "dekilliarde"
'Quelle: http://www.rhrk.uni-kl.de/~jonietz/jufo/1999a/node16.html

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ Berechnung starten
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

my_string = ""
Kommastelle = InStr(1, Eingabezahl, ",")

i = CStr(Eingabezahl)
If Kommastelle > 0 Then i = Left(CStr(Eingabezahl), Kommastelle - 1)
j = 0

'Vorzeichen?
Select Case Vorzeichenformat
   'wenn Vorzeichen erster Buchstaben im String
   Case 1, -1:
      Select Case Left(i, 1)
         Case "-": sgnm = sgminus
                   i = Right(i, Len(i) - 1) 'nicht unbedingt notwendig
         Case "+": sgnm = sgplus
                   i = Right(i, Len(i) - 1)
         Case Else: sgnm = ""
         End Select
   'alternativ, wenn vor "+" oder "-" noch andere Zeichen vorhanden sind
   Case 2, -2:
      If (InStr(1, i, "-") > 0) Then
         sgnm = sgminus
         i = Right(i, Len(i) - InStr(1, i, "-"))
         ElseIf (InStr(1, i, " + ") > 0) Then
            sgnm = sgplus
            i = Right(i, Len(i) - InStr(1, i, "+"))
            Else: sgnm = ""
         End If
   'oder "+" und "-" wird einfach ignoriert
   Case Else: sgnm = ""
   End Select
   
'Sonderfall 0
If i = "0" And Nachkommaformat = 0 Then my_string = e(0)

'spalte die Zahl in ihre (max bereich) Ziffern
While i > ""
    j = j + 1
    'ziffer(j) = i Mod 10 (geändert, da sonst Überlauf)
    'ziffer(j) = i - Fix(i / 10) * 10 (geändert, da sonst Überlauf ab 17 Stellen)
    ztemp = Right(i, 1)
   
    'Tausendertrennung etc. ignorieren
    'nur die Ziffern "0" bis "9" werden im Array abgelegt
    Select Case ztemp
       Case "0" To "9": ziffer(j) = CInt(ztemp)
       Case Else: ziffer(j) = 0
                  j = j - 1
       End Select
   
    'i = i \ 10 (geändert, da Überlauf)
    'i = Fix(i / 10) (geändert, da sonst Überlauf ab 17 Stellen)
    i = Left(i, Len(i) - 1)
    Wend
 
'Zahl ist für die Umwandlung in einen String zu gross!
If j > bereich Then
    inWorten = "Eingabezahl zu groß!"
    Exit Function
    End If
 
'Bestimmung der Anzahl der 3er Gruppen
k = (j - 1) \ 3  '0,1,2,...
 
'arbeite die Zahl in 3er Gruppen ab
'   usw
'   l=7 trilliarde
'   l=6 trillion
'   l=5 billiarde
'   l=4 billion
'   l=3 milliarde
'   l=2 million
'   l=1 tausend
'   l=0 <tausend
 
For l = k To 0 Step -1
   th = ziffer(l * 3 + 3) 'Hunderterposition
   te = ziffer(l * 3 + 1) 'Einerposition
   tz = ziffer(l * 3 + 2) 'Zehnerposition
   'erzeuge Hunderteranteil der 3erGruppe
   If th > 0 Then my_string = my_string & e(th) & d(0)
   'erzeuge Eineranteil der 3er Gruppe
   Select Case te
   Case 0: Select Case tz
             Case 0: my_string = my_string
             Case Else: my_string = my_string & z(tz)
           End Select
   Case 3, 4, 5, 8, 9: Select Case tz
                 Case 0: my_string = my_string & e(te)
                 Case 1: my_string = my_string & e(te) & z(tz)
                 Case Else: my_string = my_string & e(te) & "und" & z(tz)
                End Select
   'prüfe auf "11"
   Case 1: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(11)
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   'prüfe auf "12"
   Case 2: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(12)
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   'prüfe auf "16" und "17" sechzehn und nicht sechszehn :-(
   Case 6: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(10) & z(tz) '=sechzehn
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   Case 7: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(13) & z(tz) '=siebzehn
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   Case Else:
   End Select
 
 'wenn temp>0 muß eventuell noch was an den string
   'angehängt werden, sonst nicht!
   temp = th + tz + te
   
   If temp > 0 Then
   
    Select Case l
      Case 3, 5, 7, 9, 11, 13, 15, 17, 19, 21: '...trilliarde, billiarde, milliarde
             If te = 1 And tz = 0 Then
               my_string = my_string & "e" & d(l)
             Else
               my_string = my_string & d(l) & "n"
             End If
      Case 2, 4, 6, 8, 10, 12, 14, 16, 18, 20: '...trillion, billion, million
             If te = 1 And tz = 0 Then
               my_string = my_string & "e" & d(l)
             Else
               my_string = my_string & d(l) & "en"
             End If
      Case 1: 'tausend
             my_string = my_string & d(l)
      Case 0:
             If te = 1 And tz = 0 Then
               'wer die Änderung nicht will setzt oben die Variable undtrue=False
               If my_string <> "ein" And undtrue Then my_string = Left(my_string, Len(my_string) - 3) & "undein"
               my_string = my_string & "s"
             End If
      Case Else:
    End Select
   End If
   
   'Trennen in 3er Gruppen?
   If trenne_in_3er_gruppen And l > 0 And temp > 0 Then my_string = my_string & Trennzeichen & nl 'einfach noch ein Trennzeichen anfügen :)
 Next l
   
   If Right(my_string, Len(Trennzeichen) + Len(nl)) = Trennzeichen & nl Then
       my_string = Left(my_string, Len(my_string) - Len(Trennzeichen) - Len(nl))
       End If

'soll auch noch ein Nachkommaanteil angezeigt werden?
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
If Nachkommaformat <> 0 Then

   If trenne_in_3er_gruppen Then my_string = my_string & nl
   
   'wie lang ist der Nachkommaanteil?
   nk_lang = Len(CStr(Eingabezahl)) - InStr(1, CStr(Eingabezahl), ",")
   
   'gibt es überhaupt einen Nachkommaanteil?
   If nk_lang = Len(CStr(Eingabezahl)) Then nk_lang = 0
   
   'hol ihn aus der Ursprungszahl
   Nachkomma = Right(CStr(Eingabezahl), nk_lang)
   
   'schneide führende Nullen ab
   Do
      left_zero = InStr(1, Nachkomma, "0")
      If left_zero = 1 Then Nachkomma = Right(Nachkomma, Len(Nachkomma) - 1)
      Loop Until left_zero <> 1 Or Len(Nachkomma) < 2
   
   If nk_lang = 1 Then Nachkomma = Nachkomma & "0"
   If nk_lang = 0 And Abs(Nachkommaformat) <> 2 Then
      Nachkomma = "0"
      nk_lang = 1
      End If
   
   ' mit oder ohne "und" dazwischen?
   Trenner = ""
   If nk_lang > 0 Then Trenner = " " 'Standard
   If Nachkommaformat >= 1 And nk_lang > 0 And my_string <> "" Then Trenner = " und "
    
   'gibt es einen Vorkommaanteil >0?
   If Right(Eingabezahl, 2) = "0," Then Trenner = ""
    
   my_string = my_string & Trenner
   
   
   If Nachkomma > "0" Or Abs(Nachkommaformat) <> 2 Then
      'mach 100stel draus
      Nachkomma = Nachkomma & "/100"
   Else
      Nachkomma = ""
      nk_lang = 0
   End If
   
   'hatte der Nachkommanateil mehr als 2 Ziffern?
   lv = 0
   While nk_lang - lv > 2
      Nachkomma = Nachkomma & "0"
      lv = lv + 1
      Wend
      
   'Ergebnis inkl. Nachkommaanteil
   my_string = my_string & Nachkomma
End If

'wie lang ist der Ergebnisstring überhaupt?
If Silbentrennung_ein Then
my_string = trenneString(CStr(my_string), CInt(max_Stringlaenge), Trennzeichen)
End If

If erster_Buchstabe_gross Then my_string = UCase(Left(my_string, 1)) & Right(my_string, Len(my_string) - 1)

'ß oder ss?
If ss_ein Then my_string = aendere_sz(my_string)

'Ergebnis an Funktion übergeben
inWorten = sgnm & my_string
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ trenneString(): Silbentrennung eines Zahlwortstrings
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ Funktion absichtlich OHNE Rekursion etc.
'+ noch nicht ganz fehlerfrei?
'+ und auch nicht optimal!
'+ WENN maxStringlaenge zu klein, dann erscheint nur
'+ eine Fehlermeldung in der Ausgabezelle
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Public Function trenneString(ByVal Zahlwortstring As String, _
                             ByVal maxStringlaenge As Integer, _
                             Optional Trennzeichen = "-") As String

'lokale Variablendeklaration
Dim tr(18) As String
Dim nl As String
Dim erg_str As String
'
Dim gefunden As Boolean
'
Dim kor_pos As Integer
Dim pos As Integer
Dim i As Integer

On Error Resume Next

'initialisierung
nl = Chr(10)
'
gefunden = False
kor_pos = 0
pos = 0
erg_str = ""

If maxStringlaenge < 9 Then maxStringlaenge = 9

'Initialisierung der Suchstrings für die Silbentrennung
tr(0) = "ig": tr(1) = "lf"

tr(2) = "ein": tr(3) = "wei": tr(4) = "rei": tr(5) = "ier"
tr(6) = "ünf": tr(7) = "chs": tr(8) = "ben": tr(9) = "cht"
tr(10) = "eun": tr(11) = "ehn": tr(12) = "ion": tr(13) = "und"

tr(14) = "dert": tr(15) = "send": tr(16) = "illi"
tr(17) = "arde": tr(18) = "onen"

While Len(Zahlwortstring) > maxStringlaenge
  While (Not gefunden) And (maxStringlaenge - 4 - kor_pos) >= 0
    For i = 0 To 1
      If Mid(Zahlwortstring, maxStringlaenge - 2 - kor_pos, 2) = tr(i) Then
          pos = maxStringlaenge - kor_pos
          gefunden = True
          GoTo das_wars
      End If
    Next i
    For i = 2 To 13
      If Mid(Zahlwortstring, maxStringlaenge - 3 - kor_pos, 3) = tr(i) Then
            pos = maxStringlaenge - kor_pos
            Select Case i
              Case 2: Select Case Mid(Zahlwortstring, pos, 1)
                        Case "t", "h", "u": gefunden = True
                        Case Else: gefunden = False
                      End Select
              Case 12: If Mid(Zahlwortstring, pos, 2) <> "en" Then gefunden = True
              Case 13: If Mid(Zahlwortstring, pos - 4, 1) <> "h" Then gefunden = True
              Case Else: gefunden = True
             End Select
            If gefunden Then GoTo das_wars
      End If
    Next i
    For i = 14 To 18
      If Mid(Zahlwortstring, maxStringlaenge - 4 - kor_pos, 4) = tr(i) Then
          pos = maxStringlaenge - kor_pos
            Select Case i
              Case 17:
                 If Mid(Zahlwortstring, pos, 1) <> "n" Then
                     gefunden = True
                     Else
                     gefunden = True
                     If Mid(Zahlwortstring, pos, 4) <> "neun" Then pos = pos + 1
                     End If
              Case Else: gefunden = True
             End Select
          If gefunden Then GoTo das_wars
      End If
    Next i
    kor_pos = kor_pos + 1
  Wend
das_wars:
    erg_str = erg_str & Left(Zahlwortstring, pos - 1) & Trennzeichen & nl
    Zahlwortstring = Right(Zahlwortstring, Len(Zahlwortstring) - pos + 1)
    gefunden = False
    kor_pos = 0
Wend
trenneString = erg_str & Zahlwortstring
End Function


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ in_einzel_worten()
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ erweitert am 10.1.2001
'+ z.B. A1= "4-7stück8OBENtausend400" dann wird
'+ in_einzel_worten(A1) ausgegeben als
'+ vier-siebenstückachtOBENtausendvierhundert"
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Public Function in_einzel_worten(Eingabezahl As String, _
                                 Optional Nachkommaformat = 0, _
                                 Optional erster_Buchstabe_gross = False) As String

'lokale Variablendeklaration
Dim i As Integer
Dim l As Integer
'
Dim tchr As String
Dim ausgabe As String
Dim zahl As String
Dim pos As String

On Error Resume Next

If IsMissing(Nachkommaformat) Then Nachkommaformat = 0
tchr = ""
If Nachkommaformat <> 0 Then tchr = ","

ausgabe = ""
l = Len(Eingabezahl)
zahl = ""
For i = 1 To l
  pos = Mid(Eingabezahl, i, 1)
  Select Case pos
     Case "0" To "9": zahl = zahl & pos
                      pos = ""
     Case tchr: 'Vorkommaanteil in ausgabe ablegen
                ausgabe = ausgabe & inWorten(CStr(zahl), 0, , erster_Buchstabe_gross)
                zahl = pos
     Case Else: 'irgendein Zeichen
               If zahl <> "" Then
                   ausgabe = ausgabe & inWorten(CStr(zahl), 0, , erster_Buchstabe_gross) & pos
                   zahl = ""
               Else
                   ausgabe = ausgabe & pos
               End If
  End Select
Next i
Select Case zahl
   'letzte Ziffer Null ohne Nachkommaanteil
   Case "0": ausgabe = ausgabe & inWorten(CStr(zahl), 0, , erster_Buchstabe_gross) & pos
   Case "":
   'letzte Ziffer <> Null oder auch mit Nachkommaanteil
   Case Else: ausgabe = ausgabe & inWorten(CStr(zahl), Nachkommaformat, , erster_Buchstabe_gross) & pos
   End Select
in_einzel_worten = ausgabe
End Function


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ in_ziffern(): wandelt die Zahl ziffernweise in einen String um
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ sei A1= 3.681.147,80 dann ergibt
'+ =in_ziffern(A1;"~";2;1)
'+ die Ausgabe
'+ Drei~Sechs~Acht~Eins~Eins~Vier~Sieben 80/100
'+
'+
'+ Nachkommaformat
'+    =0    ohne Nachkommaanteil
'+    =+-1  mit Nachkommaanteil
'+    =+-2  mit Nachkommaanteil wenn > 0
'+    es wird hier kein und eingefügt
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Public Function in_ziffern(Eingabezahl As String, _
                           Optional Trenner = " ", _
                           Optional Nachkommaformat = 0, _
                           Optional erster_Buchstabe_gross = False) As String

'lokale Variablendeklaration
Dim i As Integer
Dim komma As Integer
'
Dim ausgabe As String
Dim vk As String
Dim nk As String
Dim pos As String

'Initialisierung
If IsMissing(Trenner) Then Trenner = " "
If IsMissing(Nachkommaformat) Then Nachkommaformat = 0
'
ausgabe = ""
in_ziffern = ""
komma = InStr(1, Eingabezahl, ",")
If komma > 0 Then
   vk = Left(Eingabezahl, komma - 1)
   nk = Right(Eingabezahl, Len(Eingabezahl) - komma + 1)
Else
   vk = Eingabezahl
   nk = ""
End If
For i = 1 To Len(vk)
   pos = Mid(vk, i, 1)
   Select Case pos
     Case "0" To "9": ausgabe = ausgabe & pos & Trenner
     Case ".": 'ignoriert Tausendertrennung
     Case "+", "-": ausgabe = pos
     Case Else: ausgabe = ""
   End Select
Next i
Select Case ausgabe
   Case "+", "-": ausgabe = ausgabe & nk 'Vorkommaanteil fehlt bis auf das Vorzeichen
   Case Is <> "": ausgabe = Left(ausgabe, Len(ausgabe) - 1) & nk
   Case Else: ausgabe = nk 'nur Nachkommaanteil oder falsches Zeichen dazwischen
End Select
in_ziffern = in_einzel_worten(CStr(ausgabe), Nachkommaformat, erster_Buchstabe_gross)
End Function


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ Zeilen_einrahmen(): Einrahmung jeder Zeile des Übergabestrings
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ erweitert am 28.5.2001
'+ füge bei Trennung in jeder Zeile
'+ noch spezielle Anfangs- und
'+ Endzeichen hinzu
'+
'+
'+ Standard: Rahmenstring = "***"
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Public Function Zeilen_einrahmen(Eingabestring As String, _
                                 Optional Rahmenstring = "***", _
                                 Optional min_zweiZeilen = True, _
                                 Optional min_Länge As Integer = 0) As String

'lokale Variablendeklaration
Dim nl As String
Dim teilstring As String
Dim reststring As String
Dim p As Integer
Dim temp As Integer

On Error Resume Next

'Initialisierung
nl = Chr(10)
teilstring = ""
Zeilen_einrahmen = ""

If min_Länge = 0 Then
    Eingabestring = WorksheetFunction.Substitute(Eingabestring, nl, Rahmenstring & nl & Rahmenstring)
    Zeilen_einrahmen = Rahmenstring & Eingabestring & Rahmenstring
    End If
If min_Länge > 0 Then
    reststring = Eingabestring
    Do While Len(reststring) > 0
        p = InStr(1, reststring, nl)
        teilstring = ""
        Select Case p
            Case 0:
                teilstring = reststring
                reststring = ""
            Case Is > 0:
                teilstring = Left(reststring, p - 1)
                reststring = Right(reststring, Len(reststring) - p)
            End Select
        Select Case Len(teilstring)
            Case 0:
            
            Case Is > min_Länge:
                Zeilen_einrahmen = Zeilen_einrahmen & teilstring
            Case Else:
                temp = Fix(((min_Länge - Len(teilstring)) / 2 / Len(Rahmenstring)) + 0.5)
                Zeilen_einrahmen = Zeilen_einrahmen & _
                                   WorksheetFunction.Rept(Rahmenstring, temp) & _
                                   teilstring & _
                                   WorksheetFunction.Rept(Rahmenstring, temp)
                
            End Select
        
        If Len(reststring) > 0 Then Zeilen_einrahmen = Zeilen_einrahmen & nl
        
        Loop
    End If
If min_zweiZeilen Then Zeilen_einrahmen = zusaetzlicheZeile(Zeilen_einrahmen)

End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ aendere_sz(): ändert in Eingabestring alle "ß" in "ss"
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Private Function aendere_sz(ByVal Eingabestring As String) As String

On Error Resume Next

aendere_sz = Eingabestring
aendere_sz = WorksheetFunction.Substitute(Eingabestring, "ß", "ss")

End Function


Private Function zusaetzlicheZeile(meinString As String, _
                                   Optional zeichen = "*") As String

Dim nl As String

nl = Chr(10)
zusaetzlicheZeile = meinString

If IsNull(zeichen) Then zeichen = "*"
If Len(zeichen) < 1 Then zeichen = "*"

If InStr(1, meinString, nl) = 0 Then
   zusaetzlicheZeile = meinString & nl & _
                       WorksheetFunction.Rept(zeichen, Len(meinString) \ Len(zeichen))
   End If
End Function