Antwort
von
nach 6 Tagen
0
hilfreich
Re: Serienbrief Excel/word, Zahlen als Langtext
Hallo Sven
wegen Krankheit hier meine Antwort etwas verspätet.
Die Liste enthält: Name, Anschrift und Betrag in Zahlen.
Gibt es eine Möglichkeit, eine Art von Serienbrief zu
gestalten, der nciht nur Name und Adresse von Excel nach Word
transferriert, sondern auch den Spendenbetrag in ein vorher
definiertes Feld in dem brief überträgt?
Und jetzt noch kniffeliger: Der numerische Spendenbetrag muss
auch leider zwingend ausgeschrieben (speich EUR 815,00 =
Achthundertfünfzig) werden. Geht so etwas?
Du kannst in deiner Exceltabelle in weiteren Spalten auch die Beträge so aufbereiten, wie du sie im Word-Serienbrief darstellen möchtest. Die einfache Darstellung des Betrags geht mit der Funktion TEXT
z.B., wenn Betrag in Zelle D2 seht:
="EUR " & TEXT(D2;"#.##0,00")
Den Langtext des Betrags kann man mit Excelstandard-Funktionen nur mit vielen Hilfsspalten ermitteln, da bei der Schreibweise etliche Sonderfälle berücksichtigt werden müssen.
Übersichtlicher wird die Verwendung einer benutzerdefinierten Funktion. Den nachfolgenden Code muss du im VBA-Editor in ein allgemeines Modul der Datei kopieren. Anschliessend kannst du die Funktion "ZahlZuText", wie andere Excelfunktionen in Formeln verwenden. z.B:
=ZahlZuText(D2)
Im Code muss du ggf. die Berechnung der Variablen sW1 und sW2 ein wenig anpassen, damit die Ausgabe des Zahl-Textes in der gewünschten Form erfolgt.
Gruß
Franz
Function ZahlZuText(Zahl As Double, Optional Waehrung As String = "EUR", _
Optional Waehrung2 As String = "CENT", _
Optional strFormat As String = "0.00") As String
'wandelt ein Zahlen bis 999.999.999.999,99 in Zahlen-Text
'Zahl = als Langtext auszugebende Zahl
'Waehrung = Währungskürzel/-zeichen
'Waehrung2 = Währungskürzel/-zeichen für untereinheit der Währung
'strFormat = Zahlenformat nach dem die Zahl auszuwerten und auszugen ist _
Hat die Zahl mehr Nachkommastellen als das Format, dann wird _
der Ausgabewert gerundet.
Dim iI As Long, Anz1000er As Long, l_Zahl As Long
Dim sW1 As String, sW2 As String, sZahl As String
Zahl = CDbl(Format(Zahl, strFormat))
If Zahl = 0 Then
sW1 = "null"
Else
'Vorkommazahl in Text umwandeln
'Anzahl der 3er-Gruppen in Zahl (1000er, Mio, Mrd)
Anz1000er = Int(Log(Zahl) / Log(10) / 3)
'ganze Zahl als Text mit führenden Nullen
sZahl = Format(Int(Zahl), "000000000000")
'Ziffern der Zahl in 3er-Gruppen abarbeiten
For iI = Anz1000er To 0 Step -1
l_Zahl = CLng(Left(Right(sZahl, (iI + 1) * 3), 3))
Select Case iI
Case 0 ' Ziffern - Einer
sW1 = sW1 & Text999(lZahl:=l_Zahl)
Case 1 ' Ziffern - Tausend
If l_Zahl > 0 Then
sW1 = sW1 & Text999(lZahl:=l_Zahl, b1000:=True) & "tausend"
End If
Case 2 ' Ziffern - Millionen
If l_Zahl > 0 Then
If l_Zahl = 1 Then
sW1 = sW1 & Text999(lZahl:=l_Zahl, bMio:=True) & "million"
Else
sW1 = sW1 & Text999(lZahl:=l_Zahl, bMio:=True) & "millionen"
End If
End If
Case 3 ' Ziffern - Milliarden
If l_Zahl > 0 Then
If l_Zahl = 1 Then
sW1 = sW1 & Text999(lZahl:=l_Zahl, bMio:=True) & "milliarde"
Else
sW1 = sW1 & Text999(lZahl:=l_Zahl, bMio:=True) & "milliarden"
End If
End If
End Select
Next
End If
sW1 = UCase(Left(sW1, 1)) & Mid(sW1, 2)
sW1 = sW1 & " " & Waehrung
'Nachkommazahl in Text umwandeln
If Zahl - Int(Zahl) > 0 Then
sW2 = Text999((Zahl - Int(Zahl)) * 10 ^ Len(Mid(strFormat, InStr(1, strFormat, ".") + 1)))
sW2 = UCase(Left(sW2, 1)) & Mid(sW2, 2)
sW2 = " und " & sW2 & " " & Waehrung2
Else
sW2 = ""
End If
'Ausgabetext erzeugen
ZahlZuText = sW1 & sW2
End Function
Private Function Text999(lZahl As Long, Optional bMio As Boolean, _
Optional b1000 As Boolean) As String
'Wandelt eine Zahl von 0 bis 999 in Text mit Sonderauswertungen für die Zahlen 0 und 1
Dim Ziffer As String
If lZahl = 0 Then
Text999 = ""
ElseIf lZahl = 1 And bMio = True Then
Text999 = "eine"
ElseIf lZahl = 1 And b1000 = True Then
Text999 = "ein"
Else
If lZahl > 99 Then
Ziffer = ""
Select Case Left(Format(lZahl, 0), 1)
Case "1": Ziffer = "ein"
Case "2": Ziffer = "zwei"
Case "3": Ziffer = "drei"
Case "4": Ziffer = "vier"
Case "5": Ziffer = "fünf"
Case "6": Ziffer = "sechs"
Case "7": Ziffer = "sieben"
Case "8": Ziffer = "acht"
Case "9": Ziffer = "neun"
End Select
Text999 = Ziffer & "hundert"
End If
'100er-Stelle vorne abschneiden
lZahl = lZahl Mod 100
Ziffer = ""
'Zahlen 0 bis 99 auswerten
Select Case lZahl
Case Is >= 90: Ziffer = Text10er(lZahl) & "neunzig"
Case Is >= 80: Ziffer = Text10er(lZahl) & "achtzig"
Case Is >= 70: Ziffer = Text10er(lZahl) & "siebzig"
Case Is >= 60: Ziffer = Text10er(lZahl) & "sechzig"
Case Is >= 50: Ziffer = Text10er(lZahl) & "fünfzig"
Case Is >= 40: Ziffer = Text10er(lZahl) & "vierzig"
Case Is >= 30: Ziffer = Text10er(lZahl) & "dreißig"
Case Is >= 20: Ziffer = Text10er(lZahl) & "zwanzig"
Case Is >= 13: Ziffer = Text10er(lZahl) & "zehn"
Case 12: Ziffer = "zwölf"
Case 11: Ziffer = "elf"
Case 10: Ziffer = "zehn"
Case 9: Ziffer = "neun"
Case 8: Ziffer = "acht"
Case 7: Ziffer = "sieben"
Case 6: Ziffer = "sechs"
Case 5: Ziffer = "fünf"
Case 4: Ziffer = "vier"
Case 3: Ziffer = "drei"
Case 2: Ziffer = "zwei"
Case 1: Ziffer = "eins"
Case 0: Ziffer = ""
End Select
Text999 = Text999 & Ziffer
End If
End Function
Private Function Text10er(lZahl) As String
'Teiltext der Zahlen 13 bis 99 ermitteln
If lZahl Mod 10 = 0 Then
Text10er = ""
Else
Select Case lZahl Mod 10
Case 1: Text10er = "ein"
Case 2: Text10er = "zwei"
Case 3: Text10er = "drei"
Case 4: Text10er = "vier"
Case 5: Text10er = "fünf"
Case 6: Text10er = "sechs"
Case 7: If lZahl = 17 Then Text10er = "sieb" Else Text10er = "sieben"
Case 8: Text10er = "acht"
Case 9: Text10er = "neun"
End Select
Select Case lZahl
Case Is >= 20
Text10er = Text10er & "und"
Case Else
Text10er = Text10er
End Select
End If
End Function
