Getallen in Word omzetten naar tekst.

Status
Niet open voor verdere reacties.
F

fwenk

Gebruiker
Lid geworden
15 sep 2009
Berichten
6
Ik ben op zoek naar een macro die getallen in Word kopieert en er achter omzet naar tekst.
Daarnaast moet er het woord "zegge" voor komen te staan.

bijv
€ 125,00 wordt dan € 125,00 zegge éénhondervijfentwintig

De onderstaande macro heb ik gevonden, echter werkt deze niet met decimalen en het woordje zegge komt er niet in voor.

Sub BigCardText()
Dim sDigits As String
Dim sBigStuff As String

sBigStuff = ""

' Select the full number in which the insertion point is located
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

' Store the digits in a variable
sDigits = Trim(Selection.Text)

If Val(sDigits) > 9999999 Then
If Val(sDigits) <= 999999999 Then
sBigStuff = Trim(Int(Str(Val(sDigits) / 1000000)))
' Create a field containing the big digits and
' the cardtext format flag
Selection.Fields.Add Range:=Selection.Range, _
Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
PreserveFormatting:=True

' Select the field and copy it
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
sBigStuff = Selection.Text & " millioen "
sDigits = Right(sDigits, 6)
End If
End If
If Val(sDigits) <= 9999999 Then
' Create a field containing the digits and the cardtext format flag
Selection.Fields.Add Range:=Selection.Range, _
Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
PreserveFormatting:=True

' Select the field and copy it
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
sDigits = sBigStuff & Selection.Text

' Now put the words in the document
Selection.TypeText Text:=sDigits
Selection.TypeText Text:=" "
Else
MsgBox "Number too large", vbOKOnly
End If
End Sub
 
Laatst bewerkt:
Helaas

wel vaak gekeken, echter ...nog niemand met een mooie oplossing?

Fwenk
 
Hoi Fwenk,

Ik heb niet voldoende tijd om uit te pluizen hoe het precies zit, ik heb wat zitten rommelen met de code die je mee stuurde en heb het wel werkend, maar dan enkel als je in het getal gaat staan met de cursor voor de komma.
Niet heel fraai maar misschien kan je hiermee verder knutselen

groet Karel

Code: 
Sub BigCardText()

Dim sDigits As String
Dim sBigStuff As String

sBigStuff = ""

' Select the full number in which the insertion point is located
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

' Store the digits in a variable
sDigits = Trim(Selection.Text)

If Val(sDigits) <= 9999999 Then
    ' Create a field containing the digits and the cardtext format flag
    
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
    PreserveFormatting:=True
    
    ' Select the field and copy it
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    sDigits = sBigStuff & Selection.Text
    
    ' Now put the words in the document
    Selection.TypeText Text:="zegge "
    Selection.TypeText Text:=sDigits
    Selection.TypeText Text:=" euro "
    
Else
    MsgBox "Number too large", vbOKOnly
End If
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
If Selection.Text = "," Then
    Selection.TypeText Text:=" en "

    Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
    sDigits = Trim(Selection.Text)
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
    PreserveFormatting:=True
    
    ' Select the field and copy it
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    sDigits = sBigStuff & Selection.Text
    
    ' Now put the words in the document
    Selection.TypeText Text:=sDigits
    Selection.TypeText Text:=" "
    Selection.TypeText Text:=" cent"

End If

End Sub
 
Dag Karel

De macro is in principe helmaal ok, we werken niet met cijfers achter de komma.

Echter kan van 123, 123 zegge honderddrieentwintig euro maken.
Dus dat het getal blijft staan?

Dan is het helemaal perfect...
Ik weet niks van VBA:o
 
Als je geen decimalen gebruikt en de getallen niet groter zijn dan 999999 moet onderstaande macro werken.
De functie in de originele macro voor getallen vanaf een miljoen gaf een fout in de formule dus heb ik hem hier uit gelaten.

Kan je hier wat mee?

Code: 
Sub BigCardText()
Dim sDigits As String
Dim sBigStuff As String

sBigStuff = ""

' Select the full number in which the insertion point is located
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

' Store the digits in a variable
sDigits = Trim(Selection.Text)

If Val(sDigits) <= 999999 Then
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.TypeText Text:=" zegge "
    ' Create a field containing the digits and the cardtext format flag
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
    PreserveFormatting:=True
    
    ' Select the field and copy it
    'Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    sDigits = sBigStuff & Selection.Text
    
    ' Now put the words in the document
    'Selection.TypeText Text:=sDigits
    Selection.TypeText Text:=" euro"
Else
    MsgBox "Number too large", vbOKOnly
End If
End Sub
 
Dag Karel

Dit is m helemaal, is het boven de miljoen laten weken moeilijk? Het komt niet vaak voor maar wel eens in de zoveel tijd...
 
Als je bij deze macro nog vast loopt hoop ik dat het om je salaris gaat.
Je kan hiermee een getal omrekenen tot 12 posities (999999999999).

Code: 
Sub BigCardText()
Dim sDigits As String
Dim sBigStuff As String

sBigStuff = ""

' Select the full number in which the insertion point is located
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

' Store the digits in a variable
sDigits = Trim(Selection.Text)

If sDigits > 999999999999# Then
    MsgBox ("het getal is te groot")
    Exit Sub
End If

If Val(sDigits) > 999999 Then
    
    sBigStuff = Trim(Left(sDigits, Len(sDigits) - 6))
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.TypeText Text:=" zeggen "

    ' Create a field containing the big digits and
    ' the cardtext format flag
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
    PreserveFormatting:=True
    
    ' Select the field and copy it
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    sBigStuff = Selection.Text & " miljoen "
    sDigits = Right(sDigits, 6)
End If
If Val(sDigits) <= 999999 Then

    If sBigStuff = "" Then
        Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.TypeText Text:=" zeggen "
    End If
    
    ' Create a field containing the digits and the cardtext format flag
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
    PreserveFormatting:=True
    
    ' Select the field and copy it
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    sDigits = sBigStuff & Selection.Text
    
    ' Now put the words in the document
    Selection.TypeText Text:=sDigits
    Selection.TypeText Text:=" euro "
End If
End Sub
 
Fantstisch het werkt

Ik zet dit document op een sharepointomgeving, hoe kan ik ervoor zorgen dat deze macro door iedereen gebruikt kan worden.

Groet,
 
Als je een macro opneemt kan je instellen hoe je deze wil starten.
Je kan kiezen voor een menu item of een sneltoets.
Als je dus een willekeurige macro opneemt en vervolgens de code vervangt door de code van de macro voor het omzetten van getallen naar tekst, wordt deze vervolgens gestart met het menu item of sneltoets.
 
druk ctrl+F9. Er verschijnen nu twee accolades. Tik hierbinnen het = teken, gevolgd door het bedrag in cijfers en door \*cardtext. Zodra u dit met F9 bevestigt typt word het getal uit.
 
Het heeft niet zoveel zin om op een post van bijna 2 jaar oud te reageren.... Vermoedelijk is TS al dik en breed met pensioen ;)
 
@Octafish; Mijn reactie is niet bedoeld voor TS. Maar er zijn genoeg mensen die via google een antwoord/oplossing zoeken naar zulk soort problematiek.
Misschien kunnen ze via mijn oplossing een antwoord op hun vragen vinden. Uiteindelijk is dit forum toch daarvoor?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan