1000er Trennpunkt bei Zahlen und Beträgen

Hallo Lisa,

Du hast heute einen Menschen glücklich gemacht! Vielen Dank für Deine Hilfe. Das funktioniert! Man muss es nur wissen. Was hab ich hier für Zeit verbraten….

LG Alexander und bleib gesund.

Hallo,

davon ausgehend, dass die Zahlen in der Exceldatei nicht als Text, sondern als
Zahlen formatiert sind, gehört der Punkt ja nicht zum Inhalt der Zelle, sondern wird letztlich nur eingeblendet.

Der Seriendruck übernimmt nur die Inhalte der Zellen, nicht das Format. In Word muss dem Seriendruckfeld (MERGEFIELD) ein Formatschalter für Zahlen hinzugefügt werden, z. B. { MERGEFIELD
Betrag \# ".#,00 €" } oder { MERGEFIELD Betrag \# ".0,00 €" }
oder { MERGEFIELD Betrag \# "#.##0,00 €"}.

Wählt man die letzte Variante, wird in Word allerdings ein führendes Leerzeichen verwendet, sofern die Zahl nicht im Tausenderbereich liegt.

Wird das Euro-Zeichen nicht benötigt, muss das Format nicht in Anführungszeichen gesetzt werden: { MERGEFIELD Betrag \# #.##0,00 }.

Siehe auch folgenden Artikel: https://support.microsoft.com/de-de/help/304387/date-phone-number-and-currency-fields-are-merged-incorrectly-when-you

Viele Grüße

Lisa

Hallo Willi,

schau mal hier:

http://www.excelformeln.de/tips.html?welcher=36

Claus

Beispiel: Feld A1= 22,50 € im Feld B1 soll erscheinen: Zweiundzwanzig 50/100.

Da hätte ich auch was anzubieten.

B1: =SpellNumberDE(A1;"100")

Der Code unten gehört in ein normales Modul.

Andreas.

Option Explicit

Dim BisNeunzehn As Variant

Dim Zehner As Variant

Dim Tausender As Variant

Sub Example_SpellNumberDE()

Debug.Print SpellNumberDE(12345)

Debug.Print SpellNumberDE(123.45, 2)

Debug.Print SpellNumberDE(-52.346, 2)

Debug.Print SpellNumberDE(123.456, "100")

End Sub

Function SpellNumberDE(ByVal Number As Double, Optional ByVal Places)

Dim Frac As Double

If Number < 0 Then

SpellNumberDE = "minus"

Number = Abs(Number)

End If

If IsMissing(Places) Then Places = 0

If VarType(Places) = vbString Then

Frac = Round(Number - Fix(Number), Len(Places) - 1)

Else

Frac = Round(Number - Fix(Number), Places)

End If

Number = Fix(Number)

BisNeunzehn = Array("", "ein", "zwei", "drei", "vier", _

"fünf", "sechs", "sieben", "acht", "neun", "zehn", _

"elf", "zwölf", "dreizehn", "vierzehn", "fünfzehn", _

"sechzehn", "siebzehn", "achtzehn", "neunzehn")

Zehner = Array("", "zehn", "zwanzig", "dreißig", _

"vierzig", "fünfzig", "sechzig", "siebzig", _

"achtzig", "neunzig")

Tausender = Array("", "tausend", "millionen", "milliarden", "billionen")

SpellNumberDE = SpellNumberDE & Text(Number)

If Frac > 0 Then

If VarType(Places) = vbString Then

SpellNumberDE = SpellNumberDE & " " & Frac * 10 ^ (Len(Places) - 1) & "/" & Places

Else

SpellNumberDE = SpellNumberDE & "und" & Text(Frac * 10 ^ Places)

End If

End If

End Function

Private Function Wort(Number As Integer) As String

Dim h As Integer

h = Number Mod 100

If h < 20 Then

Wort = BisNeunzehn(h)

Else

Wort = BisNeunzehn(h Mod 10) & IIf(h Mod 10 > 0, "und", "") & Zehner(Int(h / 10))

End If

h = (Number Mod 1000 - h) / 100

If h > 0 Then Wort = BisNeunzehn(h) & "hundert" & Wort

End Function

Private Function Text(Number As Double)

Dim l As Integer, i As Integer, p As Integer

Dim S As String

S = Str(Number)

For i = 1 To 1 + Int(Len(S) / 3)

p = Val("0" & Mid("000" + S, Len("000" & S) - i * 3 + 1, 3))

If p > 0 Then Text = Wort(p) & Tausender(i - 1) & Text

Next

If Right(Text, 3) = "ein" Then Stop: Text = Text & "s"

End Function

Hallo Willi,

schau mal hier rein:

https://1drv.ms/x/s!AqMiGBK2qniTgZJbpXz1kNZNJo8N5w

Du musst die Mappe herunterladen, da Makros in OneDrive nicht aktiviert sind.

Das habe ich im Netz gefunden (Autor: Nepomuk) und sollte eigentlich für dich passen.

Claus