Skrive 1.200,00 som ettusindetohundrede

Hvad f%¤## skete der med de 60 point jeg angav?

Nå, så måtte de på manuelt bagefter ;0)

Hej fogh
Jeg har kikket på gamle spørgsmå, det ligner noget med access97. Du skal som det første fjerne alle // tegn, dette virker ikke i access 2000 eller højre, prøv det som en start.

Men disse "" tegn skal bevares, så tror jeg faktisk det virker :o)

Og ,, tegn skal også bevares, så som jeg ser det er alle // tegn der skal fjernes, men resten skal bevares

Har debugget på nedenstående kode fra det gamle spørgs, jeg har blot fjernet all // tegn, det virker fint:

Public Function CheckBeløb(Beløb As String) As String
    Dim n As Integer
    CheckBeløb = "*"
    For n = 1 To Len(Beløb)
        Select Case Mid(Beløb, n, 1)
            Case "0": CheckBeløb = CheckBeløb & "nul"
            Case "1": CheckBeløb = CheckBeløb & "et"
            Case "2": CheckBeløb = CheckBeløb & "to"
            Case "3": CheckBeløb = CheckBeløb & "tre"
            Case "4": CheckBeløb = CheckBeløb & "fire"
            Case "5": CheckBeløb = CheckBeløb & "fem"
            Case "6": CheckBeløb = CheckBeløb & "seks"
            Case "7": CheckBeløb = CheckBeløb & "syv"
            Case "8": CheckBeløb = CheckBeløb & "otte"
            Case "9": CheckBeløb = CheckBeløb & "ni"
            Case ","
                CheckBeløb = CheckBeløb & Mid(Beløb, InStr(1, Beløb, ",") + 1, 2) & "/100\"
                Exit For
            Case ".": CheckBeløb = Left(CheckBeløb, Len(CheckBeløb) - 1)
        End Select
        CheckBeløb = CheckBeløb & "*"
    Next n
       
End Function

OK - jeg forsøger lige...

Det virker ikke hos mig - jeg får en 'type mismatch' - forstår det ikke... Har kopieret din tekst...

Hej !

Jeg forsøgte at udskifte tegnene på NIH's kode - og nu virker den. På nær at den skriver 'One HundredOne Thousand 00/100' for tallet 1.000,00... Kan du gennemskue hvorfor den gør det?

mvh Thomas

Her er der en der kan



Ole P. Erlandsen

Fordansket af Tommy Bak


I en forespørgsel

TalStreng: NumToText([Talfelt];Falsk)
eller
TalStreng: NumToText([Talfelt];Sand)


************* kode *************************

Option Compare Database


' the functions will not work properly if this is omitted

Option Explicit
Option Base 1 ' the functions will not work properly if this is omitted

Function NumToText(Number As Double, ShowCurrency As Boolean) As String
Dim Ipart As Double, Dpart As Long, NegValue As Boolean, sNumber As String
Dim cdGroups As Integer, dGroups() As String, dgValue() As Integer, nLen As Integer, i As Integer
 
    NumToText = "null" '*** add description for zero values
    If Abs(Number) < 0.001 Then
        If ShowCurrency Then NumToText = NumToText & " kroner" '*** add currency description
        Exit Function
    End If
    If Number < 0 Then NegValue = True Else NegValue = False
    Ipart = Fix(Abs(Number)) ' Integer part of Number
    Dpart = (Abs(Number) - Ipart) * 100 ' Decimal part of Number
    Ipart = Abs(Ipart) ' remove minus sign
    ' code for the integer part of Number
    nLen = Len(Format(Ipart, "0")) ' number of digits in Ipart
    While nLen Mod 3 <> 0
        nLen = nLen + 1
    Wend
    cdGroups = nLen / 3 ' number of digit groups
    ReDim dGroups(cdGroups) ' declare variable
    ReDim dgValue(cdGroups) ' declare variable
    sNumber = ""
    For i = 1 To nLen
        sNumber = sNumber & "0" ' create required number format
    Next i
    sNumber = Format(Ipart, sNumber) ' apply number format
    For i = 1 To cdGroups
        dGroups(i) = Mid(sNumber, (i * 3 - 2), 3) ' remember group digits
        dgValue(i) = CInt(dGroups(i)) ' remember group value
    Next i
    ' convert each digit group to text
    For i = 1 To cdGroups
        dGroups(i) = Text100(CLng(dGroups(i)), cdGroups - i + 1, cdGroups)
    Next i
    If dGroups(1) = vbNullString Then
        dGroups(1) = "null" '*** add description for zero values
    End If
    ' create output string
    NumToText = ""
    For i = 1 To cdGroups
        NumToText = NumToText & dGroups(i) & " "
    Next i
    If ShowCurrency Then ' add currency description
        If dgValue(cdGroups) = 1 Then
            NumToText = NumToText & "krone" '*** currency description for 1 unit
        Else
            NumToText = NumToText & "kroner" '*** currency description for other units
        End If
    End If
    ' code for the decimal part of Number
    If Dpart > 0 Then
        NumToText = Trim(NumToText)
        If ShowCurrency Then
            NumToText = NumToText & " og " '*** add "AND" or "COMMA" to the description
        Else
            NumToText = NumToText  '*** add "COMMA" or "AND" to the description
        End If
        If ShowCurrency Then
        NumToText = NumToText & Text100(CLng(Dpart), 1, 1) & " øre"
        Else
        NumToText = NumToText & " " & Dpart & "/100"
        End If
    End If
    Erase dGroups ' clear array variable
    Erase dgValue ' clear array variable
    If NegValue Then NumToText = "minus " & NumToText '*** add negative label if required
End Function

Private Function Text100(Number As Long, dGroup As Integer, cGroups As Integer) As String
' returns the text description for Number
' Number  : must be a value >0 and <1000
' dGroup  : the digit group for which Number belongs.
' cGroups : count of digit groups in the original number.
Dim hPart As Integer, tPart As Integer, oPart As Integer, tText As String
Dim NumberNames1 As Variant, NumberNames2 As Variant
    Text100 = ""
    If Number >= 1000 Or Number < 1 Then Exit Function
    hPart = CInt(Left((Format(Abs(Number), "000")), 1)) ' count of hundreds in Number
    tPart = CInt(Right((Format(Abs(Number), "000")), 2)) ' value less than 100 in Number
    tText = ""
    If tPart > 0 And tPart <= 19 Then
        If Number = 1 Then
            Select Case cGroups
                Case 1: tText = Text20(tPart, 1) ' get textdescription for <1 000
                Case 2: tText = Text20(tPart, 2) ' get textdescription for <1000 000
                Case Else: tText = Text20(tPart, 1) ' get textdescription for other values
            End Select
        Else
            tText = Text20(tPart, 1)  ' get text description
        End If
    End If
    If tPart > 19 Then
        oPart = tPart Mod 10 ' value less than 10 in Number
        If oPart = 0 Then
            tText = Text20(oPart, 1) & "" & Text10(CInt(Left((Format(tPart, "00")), 1)))
            Else
            tText = Text20(oPart, 1) & "og" & Text10(CInt(Left((Format(tPart, "00")), 1)))  ' get text description
        End If
    End If
    If hPart > 0 And tPart > 0 Then tText = "og" & tText '*** add "AND" to the description
    If hPart = 0 And dGroup < cGroups Then tText = "og " & tText '*** add "AND" to the description
    If hPart > 0 Then
        tText = Text20(hPart, 2) & "hundrede" & tText  '*** add "HUNDREDS" to the description
    End If
    ' add number description for thousands, millions, billions, trillions, quadrillions, quintillions, sextillions and septillions in the next two array variables
    NumberNames1 = Array("tusind", "million", "milliard", "trillion", "kvadrillion", "kvintillion", "sekstillion", "septillion") '*** description for 1 unit
    NumberNames2 = Array("tusinde", "millioner", "milliarder", "trillioner", "kvadrillioner", "kvintillioner", "sekstillioner", "septillioner") '*** description for more than 1 unit
    oPart = dGroup - 1 ' calculate index number for digit group description
    If oPart > 0 And oPart <= UBound(NumberNames1) Then
        If Number = 1 Then
            tText = tText & NumberNames1(oPart) ' add digit group description
        Else
            tText = tText & NumberNames2(oPart) ' add digit group description
        End If
    End If
    Text100 = tText ' apply function result
    Erase NumberNames1 ' clear array variable
    Erase NumberNames2 ' clear array variable
End Function

Private Function Text20(Number As Integer, Optional nAlt As Variant) As String
' returns the text description for Number
' Number : must be a value >0 and <20
' nAlt  : alternative text description for the value 1 in different positions.
' *** all 19 string descriptions in this function can be changed for internationalisation purposes
Dim t As String
    t = ""
    Select Case Number
        Case 1:
            If nAlt = 2 Then
                t = "et" ' description for first position in digit group
            Else
                t = "en" ' description for other positions in digit group
            End If
        Case 2: t = "to"
        Case 3: t = "tre"
        Case 4: t = "fire"
        Case 5: t = "fem"
        Case 6: t = "seks"
        Case 7: t = "syv"
        Case 8: t = "otte"
        Case 9: t = "ni"
        Case 10: t = "ti"
        Case 11: t = "elleve"
        Case 12: t = "tolv"
        Case 13: t = "tretten"
        Case 14: t = "fjorten"
        Case 15: t = "femten"
        Case 16: t = "seksten"
        Case 17: t = "sytten"
        Case 18: t = "atten"
        Case 19: t = "nitten"
    End Select
    Text20 = t  ' apply function result
End Function

Private Function Text10(Number As Integer) As String
' returns the text description for Number * 10
' *** all 10 string descriptions in this function can be changed for internationalisation purposes
Dim t As String
    t = ""
    Select Case Number
        Case 1: t = "ti"
        Case 2: t = "tyve"
        Case 3: t = "tredive"
        Case 4: t = "fyrre"
        Case 5: t = "halvtreds"
        Case 6: t = "tres"
        Case 7: t = "halvfjerds"
        Case 8: t = "firs"
        Case 9: t = "halvfems"
    End Select
    Text10 = t
End Function

Hej Kabak m.fl.!

Jeg har stadig samme problem, men din udgave er dog på dansk ;0)

Fx. bliver 14.231,87 til "fjortenmillioner tohundredeogenogtredive 87/100"
jeg har ellers værdien gemt som "double" / "dobbelt reelt tal".

Det kan vel næppe være noget med tusindtalsseparatoren, når nu den godt kan finde ud af hundrede'erne og ørebeløbet?

Ved brug af funktionen NumToText får jeg:

MsgBox NumToText(100.56, False) giver "ethundrede 56/100" => Korrekt

MsgBox NumToText(1000.56, False) giver "etmillion 56/100" => FORKERT

Hvor går det galt - er der nogen der kan gennemskue det?

har du husket

Option Base 1

som står øverst i koden

Ja, den stod der, men jeg havde også de to nævnte funktioner fra de tidligere spørgsmål stående - da jeg slettede dem virkede det!! (Mærkeligt)

Nu ville jeg egentlig gerne give lidt point til 'aandersen' og helst de fleste til 'kabbak' - men kabbak har ikke 'svaret' - svarer du eller hvad gør vi lige??

1000 tak for hjælpen, til jer begge ;0)
mvh Thomas

ok, et svar ;-))

tak for point

Tak for point :o)