Microsoft Office Forums - View Single Post - [Solved] Zahlen ausgeschrieben darstellen

DougMVP · 07-07-2016, 11:02 PM

Use the following:

Code:

 
Dim rng As Range
Dim str As String
Dim fld As Field
With Selection
    str = .Text
    Set fld = ActiveDocument.Fields.Add(.Range, wdFieldEmpty, True)
    Set rng = fld.Code
    rng.Text = "= " & str & "\* CARDTEXT"
    fld.Update
End With

Note that 6 is the maximum number of digits that can be handed by the \* CARDTEXT switch.

If you want to convert larger numbers (up to 12 digits), you could use:

Code:

' a Macro to insert cardtext for numbers up to 999,999,999,999
' Macro created 29/09/99 by Doug Robbins
   With Selection.Find
       .Text = ","
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindStop
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
numtext$ = Int(Val(Selection.Text))
If Val(numtext$) < 1000000 Then
   Selection.Delete
   Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
   Selection.TypeText Text:="=" & Val(numtext$) & " \* CardText"
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   Selection.Fields.Update
ElseIf Len(numtext$) < 10 Then
   millions = Val(Left(numtext$, Len(numtext$) - 6))
   Balance = Val(Right(numtext$, Len(numtext$) - Len(millions)))
   Selection.Delete
   Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
   Selection.TypeText Text:="=" & millions & " \* CardText"
   Selection.MoveRight Unit:=wdCharacter, Count:=2
   Selection.TypeText Text:=" million "
   Selection.Collapse Direction:=wdCollapseEnd
   If Balance <> 0 Then
       Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
       Selection.TypeText Text:="=" & Balance & " \* CardText"
   End If
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   ActiveDocument.Fields.Update
ElseIf Len(numtext$) < 14 Then
   billions = Val(Left(numtext$, Len(numtext$) - 9))
   millions = Val(Mid(numtext$, Len(billions) + 1, 3))
   Balance = Val(Right(numtext$, Len(numtext$) - Len(millions) - Len(billions)))
   Selection.Delete
   Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
   Selection.TypeText Text:="=" & billions & " \* CardText"
   Selection.MoveRight Unit:=wdCharacter, Count:=2
   Selection.TypeText Text:=" billion "
   Selection.Collapse Direction:=wdCollapseEnd
   If millions <> 0 Then
       Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
       Selection.TypeText Text:="=" & millions & " \* CardText"
       Selection.MoveRight Unit:=wdCharacter, Count:=2
       Selection.TypeText Text:=" million "
       Selection.Collapse Direction:=wdCollapseEnd
   End If
   If Balance <> 0 Then
       Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
       PreserveFormatting:=False
       Selection.TypeText Text:="=" & Balance & " \* CardText"
   End If
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
   ActiveDocument.Fields.Update
End If

You may need to change the grouping symbol for your region.