Quellcode in Word-VBA von Zahlmuff v0.9b
' xxx---xxx markiert anpassungspflichtige Variablen
' zzz---zzz beinhalten Verbesserungsvorschläge, bzw. nicht mehr benötigte Programmteile
' hier zur Übersicht gleich die Programm- u. Versionskonstanten deklarieren:
' zzz---zzz ACHTUNG:
Const Magmuffa_Program_Name = "Zakomuff" ' (Za)hlen(ko)vertierer (Muff)a Ali
Const Magmuffa_Skript_Version = "V0.9r0-EX2000+"
Dim B_AndOneFlag As Boolean ' dieses Flag dient dazu, bei einem einzelnen Einser an letzter Stelle allenfalls "und" dazuzukonvertieren (falls gewünscht)
Dim B_EndOneFlag As Boolean ' dieses Flag dient dazu, bei einem letzten vorkommenden Einser im Einertrippel die volle Zahl "eins" zu nennen anstatt "ein" als Bindewort zwischen den höheren Trippeln, die ja das "ein" über das Klartextindexfeld erhalten
' www.Issog.com - Word-Makro zur Zahlenkonvertierung von Zahlen in Klartext (DEUTSCH)
' (c) 2009 by Magmuffa Philissog
' www.Issog.com / +43-664-5663421
' Dompl. 11, 7000 Eisenstadt, Austria - Europe
' #########################
' K U R Z A N L E I T U N G
' #########################
' 1. Man gebe eine Zahl in Word ein, man rufe "convert_numbers" auf und erhält die konvertierte Zahl
' 2. Man rufe "display_numbers" auf und gebe die untere und obere Zahlengrenze für die zu konvertierenden Zahlen ein
' Dieses Sub holt eine markierte Zahl aus Word und konvertiert sie in Klartext
Sub convert_number()
Const CB_NoList = False ' standardm. wird hier nicht das Listenformat benötigt -> eben NoList
Dim S_number_to_convert As String
S_number_to_convert = Selection.Text ' markierte Zahl aus Word holen
Call convert_number_to_full_string_german(S_number_to_convert, CB_NoList) ' markierte Zahl aus Word konvertieren
End Sub
' Dieses Sub konvertiert eine übergebene Zahl in Klartext.
Sub convert_number_to_full_string_german(S_number_to_convert As String, B_liststatus As Boolean)
' Funktionsweise:
' Die Zahl wird zuerst in ihre 3-er-Gruppen zerschlagen. Anhand dieser "Blöcke" wird im weiteren Verlauf festgestellt,
' wie viele derartige Trippel es zu konvertieren gibt. Diese Blöcke werden dann durch die Funktion "convert_number_parts"
' konvertiert und als ausgeschriebene Zahlen zwischen null und neunhundertneunundneunzig zurückgeliefert. Alles was das
' aufrufende Sub noch tun muss, ist, an diese erhaltenen konvertierten Trippel die entsprechenden Stellenbezeichnungen
' für Millionen, Hunderttausender, oder Trilliarden, bzw. was auch immer dazuhängen und auf Sonderfälle wie null und eins
' (wegen Einzahl und Mehrzahl) zu achten. Das Programm lässt sich somit beliebig erweitern. Ich habe allerdings bei der
' Speicherplatzreservierung für die Oktilliarden Schluss gemacht (sollte auch reichen).
' Noch ein Programmdetail: der Code arbeitet bewusst mit Arrays von Strings und keinem "normalen" String, da dieser die
' Länge bei ausgeschriebenen Zahlen von 255 Zeichen sehr schnell erreichen könnte. C würde dies nicht stören, da dort die
' Strings nullterminitert sind, aber der hier verwendete Algorithmus soll auch in Pascal funktionieren. Da er ohnehin
' nicht zeitkritisch ist, ist dies somit egal. Die Ausgabe der Klartextzahl erfolgt wegen der Arrays in Schleifenform,
' die die einzelnen Arrayblöcke (mit den einzelnen in Klartext konvertierten Trippeln) abgrast.
' technischer Hinweis: ich verwende in allen meinen Programmen und Skripts anstatt Integern Longs, da diese auf heutigen
' Rechnern schneller verarbeitet werden als die kleineren Integer - dies auch dann, wenn gar keine Werbereiche für Longs
' auftreten.
' hier kann man den Wertebereich erweitern... xxx---xxx
Const CI_Convertlimitblocks = 18 ' hier wird festgelegt, wie viele Zahlentrippel die zu konvertierende Zahl haben darf (bei 18 sind dies eben 54)
Const CI_WordForOneThousand = 1 ' Index in das Klartextzahlenfeld für das Klartextwort "eintausend"
Const CI_WordForThousands = 2 ' Index in das Klartextzahlenfeld für das Klartextwort "tausend" (zum Anhängen)
Const CS_WordForEineGerman = "eine" ' hier wird "eine" definiert als Spezialfall, wenn ab der Millionentrippel nur eine davon vorliegt
Const CS_WordForZero = "null" ' 0 ausgeschrieben für Vergleichszwecke...
Dim I_amount_number_blocks As Long
Dim I_length_number_to_convert As Long
Dim I_runcounter As Long
Dim S_number_to_convert_buffer As String
Dim S_convert_parts(CI_Convertlimitblocks) As String
Dim S_converted_string(CI_Convertlimitblocks) As String
Dim I_convert_parts_values(CI_Convertlimitblocks)
Dim S_number_names(CI_Convertlimitblocks)
' Namenbausteine für die Zahlenaufbereitung (=Zuweisung der Stellenwertigkeiten ab der Million definieren)
' unter 1 Million erfolgt "Sonderbehandlung" wegen der Tausender, da darin nicht die Silbe "illion", bzw. "illiard"
' drin ist, was unnötige Verkomplizierung des Algorithmus bedeuten würde
S_number_names(0) = "en"
S_number_names(1) = "eintausend"
S_number_names(2) = "tausend"
S_number_names(3) = "million"
S_number_names(4) = "milliard"
S_number_names(5) = "billion"
S_number_names(6) = "billiard"
S_number_names(7) = "trillion"
S_number_names(8) = "trilliard"
S_number_names(9) = "quadrillion"
S_number_names(10) = "quadrilliard"
S_number_names(11) = "quintillion"
S_number_names(12) = "quintilliard"
S_number_names(13) = "sextillion"
S_number_names(14) = "sextilliard"
S_number_names(15) = "septillion"
S_number_names(16) = "septilliard"
S_number_names(17) = "oktillion"
S_number_names(18) = "oktilliard"
' -------------------------------------------------------------------------------------------------------------------------
' ab hier folgt vorerst "Word-Spezifisches..." - beim Transpilieren in andere Programmiersprachen müssen hier entsprechende
' Anpassungen erfolgen
' -------------------------------------------------------------------------------------------------------------------------
B_AndOneFlag = False ' xxx---xxx hier allenfalls die Feinsteuerung für die Ausgabe des letzten Einsers festleten ("und" oder nicht)
B_EndOneFlag = False
I_length_number_to_convert = Len(S_number_to_convert)
S_converted_string(0) = Mid(S_number_to_convert, I_length_number_to_convert, 1)
If S_converted_string(0) = Chr(13) Then
S_number_to_convert = Mid(S_number_to_convert, 1, I_length_number_to_convert - 1)
End If
If Len(S_number_to_convert) > CI_Convertlimitblocks * 3 Then ' ist die Zahl "handlebar", d.h. liegen Definitionen und Arrays dafür vor
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Die eingegebene Zahl ist zu lang - max. " + Str(CI_Convertlimitblocks * 3) + " Ziffern!") ' nein, dann Meldung ausgeben, dass etwas gewählt wird
Exit Sub ' und Sub beenden
End If
If S_number_to_convert = "" Then ' wurde nichts gewählt?
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Bitte etwas markieren!") ' dann Meldung ausgeben, dass etwas gewählt wird
Exit Sub ' und Sub beenden
End If
If IsNumeric(S_number_to_convert) = False Then ' liegt überhaupt keine Zahl vor
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Sie haben leider keine ""reine"" Zahl eingegeben - vermutlich sind darin störende Buchstaben oder Sonderzeichen drinnen...") ' ja, dann Meldung ausgbene
Exit Sub ' und Sub beenden
End If
S_number_to_convert_buffer = S_number_to_convert
' -----------------------------------------------------------------------------------------------
' ENDE des "Word-Spezifischen" (Eingabe-Teils)
' ab hier folgt der Umwandlungscode, der sich auch in andere Programmiersprachen übertragen lässt
' -----------------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------------
' Beginn des Verarbeitungsteils
' ab hier folgt der Umwandlungscode, der sich auch in andere Programmiersprachen übertragen lässt
' -----------------------------------------------------------------------------------------------
' zuerst die Spezialfälle 0 und 1 prüfen
I_amount_spare_digits = Len(S_number_to_convert) Mod 3 ' feststellen, ob 3er-Blöcke ohne Rest existieren
If I_amount_spare_digits = 1 Then ' nein -> 2 Ziffern fehlen
S_number_to_convert = "00" + S_number_to_convert ' mit Nullen füllen (wegen korrekter Stringberechnung der Wertigkeitsstellen)
End If
If I_amount_spare_digits = 2 Then ' nur 1 Ziffer fehlt
S_number_to_convert = "0" + S_number_to_convert ' mit Führungsnull füllen (wegen korrekter Stringberechnung der Wertigkeitsstellen)
End If
I_amount_number_blocks = Len(S_number_to_convert) / 3 ' nun die korrekte Anzahl der Blöcke ermitteln: garantiert ohne Rest nun, d.h. korrekt
For I_number_splitter = 1 To I_amount_number_blocks ' Zahl in die erhaltene Anzahl 3er-Blöcke teilen
S_convert_parts(I_number_splitter) = Mid(S_number_to_convert, I_number_splitter * 3 - 2, 3) ' jeweils 3 Stellen davon in das Stringfeld legen
I_convert_parts_values(I_number_splitter) = Val(S_convert_parts(I_number_splitter)) ' gleich auch den Wert diese Blockes als Nummer in das Nummernfeld legen (dient für spätere Berechnungen damit)
Next I_number_splitter
' Klartext-Benennungen ab der Millionenstelle durchführen (falls diese vorhanden ist, also mehr als 2 Blöcke existieren, d.h. eine 7. Ziffer)
I_runcounter = 1 ' Schleifenzähler initialisieren - mit diesem wird später berechnet, in welchem Feldindex die Einer bis Hunderterstellen stehen (sonst wird der Index darauf nicht gefunden)
If I_amount_number_blocks > 2 Then ' liegen mehr Zahlentrippel als bis zu den Hunderttausenderstellen vor?
For I_number_converter = 1 To I_amount_number_blocks - 2 ' ja, dann Sonderbehandlung für Einzahl / Mehrzahl (-en anhängen) und Sonderfall "eine" mit, bzw. ohne angehängtem "e"
If I_convert_parts_values(I_number_converter) = 0 Then ' kommt ein Zahlentrippel eines Stellenbereiches gar nicht vor?
GoTo next_run ' ja, dann dieses auslassen, da es nicht als Klartext aufscheint in der ausgeschriebenen Zahl
End If
If I_convert_parts_values(I_number_converter) = 1 Then ' liegt nur 1 "Stück" dieses Zahlenstellenbereiches des Zahlentrippel vor?
S_converted_string(I_number_converter) = CS_WordForEineGerman + _
S_number_names(I_amount_number_blocks - I_number_converter + 1) ' ja, dann Sonderbehandlung: "eine" wird auf jeden Fall schon einmal eingefügt
If (I_amount_number_blocks - I_number_converter + 1) Mod 2 = 0 Then ' weiter unterscheiden, ob es sich um einen geraden oder ungeraden Index handelt
S_converted_string(I_number_converter) = S_converted_string(I_number_converter) + "e" ' je nachdem, das "e" für Billiard(e), Trilliard(e), etc... anhängen oder bei Billion, Trillion, etc... dies NICHT tun
End If
Else ' es liegen also mehr als 1 vor...
S_converted_string(I_number_converter) = convert_number_parts(S_convert_parts(I_number_converter)) + _
S_number_names(I_amount_number_blocks - I_number_converter + 1) + "en" ' d.h. also "en" anfügen (=Mehrzahl)
End If
next_run:
I_runcounter = I_runcounter + 1 ' Indexzähler für nächstes Zahlentrippel erhöhen
Next I_number_converter
End If
' Klartext-Benennung ab der Tausenderstelle durchführen (falls diese vorhanden ist, also mehr als 1 Block existiert, d.h. eine 4. Ziffer)
If I_amount_number_blocks > 1 Then ' prüfen, ob es die Tausenderstellen überhaupt gibt
If I_convert_parts_values(I_runcounter) = 1 Then ' ja, dann weiterprüfen, ob nur 1000 da sind, d.h. dann "eintausend"
S_converted_string(I_runcounter) = S_number_names(CI_WordForOneThousand) ' ja, dann diese 1000 als Klartext "eintausend" konvertieren
End If
If I_convert_parts_values(I_runcounter) <> 0 And I_convert_parts_values(I_runcounter) <> 1 Then ' liegt 0 (oder 1 vor), so DARF nicht mehr weiterkonvertiert werden
Rem ttt Fehler??? ein(s) Achtung auf 0
S_converted_string(I_runcounter) = convert_number_parts(S_convert_parts(I_runcounter)) + _
S_number_names(CI_WordForThousands) ' ansonsten MÜSSEN die Tausenderstellen normal konvertiert werden mit angefügtem "tausend" als Klartext
End If
I_runcounter = I_runcounter + 1 ' Indexzähler für nächstes Zahlentrippel erhöhen (=in diesem Fall das Letzte dann, da nach den Tausendern nur mehr die Einer- bis Hunderterstellen bleiben)
End If
B_EndOneFlag = True
S_converted_string(I_runcounter) = convert_number_parts(S_convert_parts(I_runcounter)) ' übrige Stellen (Einerstellen) kovertieren
' hier muss noch geprüft werden ob die Einerstellen allesamt 0 waren, aber höherwertige Stellen vorlagen
' damit wird die Ausgabe z.B. einhunderttausendnull verhindert
B_not_display_zero_at_last_tripple = False ' zuerst davon ausgehen, dass kein "null" vorlag
If S_converted_string(I_runcounter) = CS_WordForZero And I_runcounter > 1 Then ' lag es aber vor?
B_not_display_zero_at_last_tripple = True ' dann vermerken, dass dieses nicht mit ausgegeben werden darf
End If
' -----------------------------------------------------------------------------------------------
' ENDE des Verarbeitungsteils
' ab hier folgt der Umwandlungscode, der sich auch in andere Programmiersprachen übertragen lässt
' -----------------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------------
' Beginn des Ausgabeteils / wieder speziell für Word
' -----------------------------------------------------------------------------------------------
' nun noch die eigentliche Ausgaberoutine ausführen (solange bis der Laufzähler erreicht, d.h. die Anzahl der Trippel abgearbeitet = Ausgegeben sind)
If B_liststatus = False Then ' wird kein Listenformat gewünscht (aus display_numbers)
Rem hier ist schon vorbereitet, dass eine Dialogbox abfragen soll, ob die Zahl stehen bleibt -> das Equivalenzzeichen
Selection.TypeText Text:=S_number_to_convert_buffer + " <=> " ' ja, dann normale Selection-Ausgbae vorbereiten (mit gepufferter unveränderter, d.h. NICHT um allfällige Führungsnullen aufgefüllte Zahl, die der korrekten Konvertierung dienen)
Else
Selection.TypeText Text:=S_number_to_convert + ": " ' nein, dann Listenausgabe vorbereiten
End If
For I_amount_number_blocks = 1 To I_runcounter ' nicht mehr gebrauchte Zahlenblockvariable gleich als Schleifenzähler für Ausgabe nutzen (bis zum Durchlaufzähler: dort stehr die Anzahl der konvertierten Strings)
If I_amount_number_blocks = I_runcounter And B_not_display_zero_at_last_tripple = True Then ' wurde bis zu den Einer- und Hunderterstellen alles ausgegeben, liegt dort aber "null" vor
Exit For ' ja, dann DARF dieses angehängte "null" nicht ausgegeben werden
End If
Selection.TypeText Text:=S_converted_string(I_amount_number_blocks) ' konvertiertes Zahlentripple Stück für Stück ausgeben lassen
Next I_amount_number_blocks
If B_liststatus = False Then ' wird kein Listenformat gewünscht (aus display_numbers)
Selection.MoveLeft Unit:=wdWord, Count:=3 ' ja, dann normale "Selection"-Ausgabe für Word
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete
Else
Selection.TypeText Text:=Chr(13) ' nein, dann am Zeilenende noch ein Vorschubzeichen setzen für die nächste Zeile und die nächste Zahl im Intervall
End If
End Sub
' Dieses Sub gibt ein entsprechendes (Test)intervall von Zahlen in Klartext aus
Sub display_numbers()
Const CB_YesList = True ' standardm. wird hier schon das Listenformat benötigt -> eben YesList
Const CI_Maxintervall = 100000 ' max 100.000 Zahlen konvertieren lassen
Dim I_counter As Long
Dim S_string_to_convert_and_display As String
Dim D_low_number As Double
Dim D_high_number As Double
On Error GoTo errorout ' Fehlerhandler setzen, falls jemand auch Buchstaben eingibt
' xxx---xxx Meldungen sprachspezifisch
D_low_number = InputBox("Bitte untere Intervallgrenze eingeben") ' untere Intervallgrenze holen
D_high_number = InputBox("Bitte obere Intervallgrenze eingeben") ' obere Intervallgrenze holen
On Error GoTo 0 ' Fehlerhandler wieder aufheben
D_low_number = Round(D_low_number, 0)
D_high_number = Round(D_high_number, 0)
If D_high_number < D_low_number Then ' untere Intervallgrenze größer als obere?
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Hinweis: Die untere Zahl ist niedriger als die obere Zahl!" + vbCrLf _
+ "Ich tausche die Zahlen aber gerne für Sie und mache weiter!") ' ja Tauschwarnmeldung geben
I_counter = D_high_number ' Ausgabenzähler für Liste gleich als Tauschpuffer verwenden
D_high_number = D_low_number ' Tausch durchführen
D_low_number = I_counter
End If
If D_high_number - D_low_number > CI_Maxintervall Then ' wollen mehr als 100.000 konvertiert werden?
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Hinweis: Sind Sie wahnsinnig??? Wollen Sie Word abstürzen lassen!" + vbCrLf _
+ "Ich reduziere Ihr Intervall auf ""nur""" + Str(CI_Maxintervall) + " Zahlen!" + vbCrLf _
+ "Viel Glück! Denn auch so schmieren alte Rechner zwischen 800 u. 1000 Seiten" + vbCrLf _
+ "mit kovertierten Zahlenkolonnenlisten ab...") ' ja, Warnmeldung ausgeben
D_high_number = D_low_number + CI_Maxintervall - 1 ' und kürzen
End If
For D_counter = D_low_number To D_high_number ' Wunschbereich mit Zahlen abgrasen
S_string_to_convert_and_display = Str(D_counter) ' aus der Zahl einen String bilden
S_string_to_convert_and_display = Mid(S_string_to_convert_and_display, 2, Len(S_string_to_convert_and_display)) ' von diesem String den VBA-spezifischen Vorzeichenteil abschneiden
I_string_to_convert_and_display_length = Len(S_string_to_convert_and_display) ' Länge auf diesen neuen String holen
If I_string_to_convert_and_display_length = 1 Then ' fehlt eine Stelle auf ein Trippel?
S_string_to_convert_and_display = "00" + S_string_to_convert_and_display ' ja, dann diese durch eine Führungsnulle ersätzen
End If
If I_string_to_convert_and_display_length = 2 Then ' fehlen zwei Stellen auf ein Trippel?
S_string_to_convert_and_display = "0" + S_string_to_convert_and_display ' ja, dann diese durch zwei Führungsnullen ersätzen
End If
Call convert_number_to_full_string_german(S_string_to_convert_and_display, CB_YesList) ' Unterroutine zur Konvertierung und Ausgabe aufrufen
Next D_counter
GoTo endsub ' Fehlerhandler überspringen
errorout:
' xxx---xxx Meldung sprachspezifisch
MsgBox ("Ungültige Zahl eingegeben - bitte eine Zahl eingeben") ' da der einzige "normal auftretende" Fehler hier Buchstaben statt Zahlen sind, dies melden
endsub:
End Sub
' Diese Funktion wandelt ein übergebenes Zahlentrippel in Klartext um (um die Anfügung von -million[en], -tausend, -sextilliarde[n], etc... muss sich die Aufrufroutine kümmern)
Function convert_number_parts(S_string_to_be_converted_from_caller As String) As String
' hier KÖNNTE die Konstanten "AND" stehen -> da dies aber das reservierte Programmierwort für Und-Verknüpfungen ist, wird
' hier ausnahmsweise davon Abstand genommen und eine eingedeutschte Varible statt einer englischen genommen
Const CI_UND = 0 ' Index in das Klartextzahlenfeld für das Klartextwort "und"
Const CI_HUNDERT = 3 ' Index in das Klartextzahlenfeld für das Klartextwort "hundert"
' xxx---xxx sprachspezifische Bezeichnungen (so man "Deutschalgorithmitk" auch auf andere Sprachen übertragen kann)
Const CS_WordForAnd = "und" ' das Wort für "und" definieren
Const CS_WordForOne = "eins" ' das Klartextwort für 1 definieren (im Klartextfehlt steht lediglich das Bindunsgwort "ein")
Const Einerstelle = 1 ' zur besseren Lesbarkeit für das Handling des Zahlentrippelstring die Einerstelle definieren
Const Zehnerstelle = 2 ' zur besseren Lesbarkeit für das Handling des Zahlentrippelstring die Zehnerstelle definieren
Const Hunderterstelle = 3 ' zur besseren Lesbarkeit für das Handling des Zahlentrippelstring die Hunderterstelle definieren
Dim S_number_parts(100) As String ' die Text-Bausteine für die ausgeschriebenen Zahlen definieren
' xxx---xxx sprachspezifische Bezeichnungen (so man "Deutschalgorithmitk" auch auf andere Sprachen übertragen kann)
S_number_parts(0) = "null"
S_number_parts(1) = "ein"
S_number_parts(2) = "zwei"
S_number_parts(3) = "drei"
S_number_parts(4) = "vier"
S_number_parts(5) = "fünf"
S_number_parts(6) = "sechs"
S_number_parts(7) = "sieben"
S_number_parts(8) = "acht"
S_number_parts(9) = "neun"
S_number_parts(10) = "zehn"
S_number_parts(11) = "elf"
S_number_parts(12) = "zwölf"
S_number_parts(13) = "dreizehn"
S_number_parts(14) = "vierzehn"
S_number_parts(15) = "fünfzehn"
S_number_parts(16) = "sechzehn"
S_number_parts(17) = "siebzehn"
S_number_parts(18) = "achtzehn"
S_number_parts(19) = "neunzehn"
S_number_parts(20) = "zwanzig"
S_number_parts(30) = "dreißig"
S_number_parts(40) = "vierzig"
S_number_parts(50) = "fünfzig"
S_number_parts(60) = "sechzig"
S_number_parts(70) = "siebzig"
S_number_parts(80) = "achtzig"
S_number_parts(90) = "neunzig"
S_number_parts(100) = "einhundert"
Dim S_number_concat_words(16) As String ' das Klartextfeld mit den Bindewörtern definieren (100 steht dort aus dezimalgeschmacklichen Gründen an Pos. 3, wo es der Logik nach auch hingehört)
' xxx---xxx sprachspezifische Bezeichnungen (so man "Deutschalgorithmitk" auch auf andere Sprachen übertragen kann)
' darum sind auch die Indizes 1 und 2 reserviert / 3 ist genommen worden, da dies ja auch der Hunderterlogik entspricht (war aber nicht zwingend, da es ums Konvertieren in Klartext geht...)
S_number_concat_words(0) = "und" ' CI_UND zeigt hier herein
S_number_concat_words(1) = "reserviert für künftige Kovertierungsroutine(n) in andere Sprachen"
S_number_concat_words(2) = "reserviert für künftige Kovertierungsroutine(n) in andere Sprachen"
S_number_concat_words(3) = "hundert" ' CI_HUNDERT zeigt hier herein
Dim S_triple_parts(3) As String ' die Zahlen sind alle 3-stellig (Einer-, Zehner-, Hunderterstelle)
Dim S_string_to_be_converted As String
Dim I_string_to_be_converted_lenght As Long
S_string_to_be_converted = S_string_to_be_converted_from_caller ' übergebenes Zahlentrippel unangetastet lassen - lokale Kopie erstellen (entspricht "Call by Value")
I_number_value = Val(S_string_to_be_converted) ' den Zahlentrippelstring in einen "echten" Zahlenwert wandeln, mit dem man (be)rechnen kann
' die Sonderfälle "genau" 0 und 100 behandeln
If I_number_value = 0 Then ' genau Zahl "0"?
convert_number_parts = S_number_parts(0) ' ja, dann diese aus dem Klartextbezeichnungsfeld holen und an dieser Stelle fertiges Zahlentrippel übergeben
Exit Function ' Funktionsende
End If
Rem ttt
Rem If I_number_value = 1 Then ' genau Zahl "1"?
Rem convert_number_parts = CS_WordForOne ' ja, dann diese aus der Konstantendefinition holen (für Deutsch zwingend, da "eins" ungleich dem Bindewort "ein" ist, bzw. dem Endwort "(und)eins" für Lange Zahlen, falls eben mit "und" gewünscht
Rem Exit Function ' Funktionsende
Rem End If
If I_number_value = 100 Then ' genau Zahl "100"?
convert_number_parts = S_number_parts(100) ' ja, dann diese aus dem Klartextbezeichnungsfeld holen und an dieser Stelle fertiges Zahlentrippel übergeben
Exit Function ' Funktionsende
End If
' Sonderfall mit Führungsnull (bei langen Zahlen mit mehreren Blöcken, wo eben solche drin sind können Zwischennullen
' auftreten, die dann im jeweils übergebenen Trippel als Führungsnullen erscheinen)
' hier muss / müssen diese zur korrekten Aufbereitung und Konvertierung eliminiert werden - entspricht auch der Sprache,
' da Zwischennullen eben nicht gesprochen, sondern ignoriert werden - es geht dann eben wieder mit "dem weiter, wo
' etwas zum Konvertieren da ist"
Rem ttt null EN!!!! ?????????
If I_number_value > 10 And I_number_value < 100 Then ' liegt eine Führungsnull vor (Wert also unter 100 beim aktuellen Zahlentrippel)?
S_string_to_be_converted = Mid(S_string_to_be_converted, 2, 2) ' ja, dann die Null abschneiden (sonst stimmen die weiteren Stringstellen nicht mit der Integerwertigkeit und den Berechnungen damit zusammen)
End If
' die Zahlen über 100
If I_number_value > 100 Then
S_triple_parts(Hunderterstelle) = Mid(S_string_to_be_converted, 1, 1) ' zuerst Hunderterstelle holen
I_hundert_part = Val(S_triple_parts(Hunderterstelle)) ' und gleich auch den Zahlenwert
convert_number_parts = S_number_parts(I_hundert_part) + S_number_concat_words(CI_HUNDERT) ' daraus Klartextwort "xyzhundert" bilden
I_number_value = I_number_value - I_hundert_part * 100 ' vom Zahlenwert das Vielfache der Hunderterstelle abziehen
If I_number_value = 0 Then ' war dies ein runder 100er?
Exit Function ' ja, dann MUSS zwingend gleich Sense gemacht werden, sonst werden die "Nachnullen" noch konvertiert -> Zahlentrippel fertig, d.h. übergeben
End If
S_string_to_be_converted = Mid(S_string_to_be_converted, 2, 2) ' ansonsten müssen noch die verbleibenden Zehnerstellen in Klartext "dazukonvertiert" werden -> den Konvertierstring auf diese zurechtstutzen
End If
' Spezialfall für Deutsch: je nachdem "eins" oder Bindewort "ein" dazukonstruieren
If I_number_value = 1 Then ' liegt überhaupt ein Einser vor -> Zehnerstelle 0
If B_EndOneFlag = True Then ' handelt es sich um die Einerstelle (=der letzte Einser), d.h. das letzte Zahlentrippel (vom Aufrufer so gesetzt)?
If B_AndOneFlag = True Then ' ja, prüfen ob noch "und" vor diesen gesetzt werden soll (=Geschmackssache)
convert_number_parts = convert_number_parts + CS_WordForAnd ' ja, durchführen
End If
convert_number_parts = convert_number_parts + CS_WordForOne ' nein, dann die Eins normal dazukonvertieren und an dieser Stelle fertiges Zahlentrippel übergeben
Else
Rem ttt
convert_number_parts = convert_number_parts + S_number_parts(1) ' nein, es war eine höherwertige Stelle, d.h. ein "Bindeeinser" (="ein" aus dem Klartextindexfeld) gehört dazukonvertiert / an dieser Stelle fertiges Zahlentrippel übergeben
End If
Exit Function ' Funktionsende
End If
' hier erfolgt der Test auf die Zahlen bis 10 (da 0 und 1 schon behandelt sind, kann es nur noch um die Ziffern 2-9 gehen)
If I_number_value < 10 Then ' liegt eine dieser Kandidaten vor?
S_triple_parts(Einerstelle) = Mid(S_string_to_be_converted, 3, 1) ' ja, dann den Kandidaten genau holen
convert_number_parts = convert_number_parts + S_number_parts(I_number_value) ' dessen Index in das Klartextbezeichnungsfeld nutzen und an dieser Stelle fertiges Zahlentrippel übergeben
Exit Function ' Funktionsende
End If
' Sonderfall 10 genau - heißt nämlich nicht "nullundeins" / steht hier auch deswegen, da auch Zahlen wie 210, 710, etc... vorkommen
If I_number_value = 10 Then ' liegt eben dieser "Zehnerfall" vor?
convert_number_parts = convert_number_parts + S_number_parts(10) ' ja, dann den 10er-Index in das Klartextbezeichnungsfeld nutzen und an dieser Stelle fertiges Zahlentrippel übergeben
Exit Function ' Funktionsende
End If
' nun auf die Zahlen von 11 bis 99 abtesten
If I_number_value > 10 And I_number_value < 100 Then ' liegt eine davon vor?
S_triple_parts(Einerstelle) = Mid(S_string_to_be_converted, 2, 1) ' ja, Einerstelle holen
S_triple_parts(Zehnerstelle) = Mid(S_string_to_be_converted, 1, 1) ' Zehnerstelle auch
' 11 - 20 gesondert behandeln - heißen allesamt nicht einundzehn, zweiundzehn, usw...
If I_number_value > 10 And I_number_value < 21 Then ' liegt eine dieser "Spezialzahlen" vor?
convert_number_parts = convert_number_parts + S_number_parts(I_number_value) ' ja, dann den jeweiligen Index der Zahl gleich als Index in des Klartextbezeichungsfeld verwenden
Exit Function
End If
' das Wortpaar "xyzund" nur dann anfügen, wenn die Einerstelle nicht 0 ist, sonst käme z.B. "nullunddreißig" heraus,
' anstatt "dreißig" alleine, d.h. also, dass hier die runden Zehnerstellen (Ausnahme 10 genau [da oben] und wegen
' elf, zwölf, usw...) bedacht werden müssen - gibt es aber eine Einerstelle wird die eben z.b. à la "siebenund"
' konstruiert
If Val(S_triple_parts(Einerstelle)) <> 0 Then ' gibt es also eine nicht "0 seiende Einerstelle"?
convert_number_parts = convert_number_parts + S_number_parts(Val(S_triple_parts(Einerstelle))) + S_number_concat_words(CI_UND) ' ja, dann "EINERSTELLEund" konstruieren
End If
' (und) die runde Zehnerstelle aus dem Klartextbezeichnungsfeld dazuholen, indem sie mit 10 multipliziert wird
' (dies entspricht dann gleich auch dem Index darin, genau wie bei den Spezialzahlen 10-20 und den Einerstellen)
' spätestens mit den Einerstellen und dem Dazufügen der Zehnerstellen ist das Zahlentrippel endgültig fertig in
' Klartext konvertiert - es folgt die finale Übergabe und das Funktionsende:
convert_number_parts = convert_number_parts + S_number_parts(Val(S_triple_parts(Zehnerstelle) * 10))
End If
End Function
' Dieses Sub schreibt ein Klartextminus "minus"
Sub display_Klartextminus()
Selection.TypeText Text:="minus "
End Sub
' Dieses Sub schreibt ein Klartextplus "plus"
Sub display_Klartextplus()
Selection.TypeText Text:="plus "
End Sub
zurück