Problemer med Bathtekst i Excel

Jeg fandt denne løsning på nettet. Den er godt nok på engelsk, men du kan måske selv rette den til:

Public Function NumberToText(Num As Variant, Optional vCurName As Variant, Optional vCent As Variant) As Variant
    Dim TMBT As Variant
    Dim sNum As String, sDec As String, sHun As String, IC As Integer
    Dim Result As String, sCurName As String, sCent As String
   
    If Application.IsNumber(Num) = False Then
        NumberToText = CVErr(xlValue)
        Exit Function
    End If
   
    If IsMissing(vCurName) Then
        sCurName = ""
    Else
        sCurName = Trim(CStr(vCurName))
    End If
    If IsMissing(vCent) Then
        sCent = ""
    Else
        sCent = Trim(CStr(vCent))
    End If
   
    TMBT = Array("", "Thousand", "Million", "Billion", "Trillion", "Quadrillion", "Quintillion", "Sextillion")
   
    If IsMissing(sCent) Or IsNull(sCent) Then
        sNum = Format(Application.Round(Num, 0), "0")
    Else
        sNum = Format(Application.Round(Num, 2), "0.00")
        sDec = Right(sNum, 2)
        sNum = Left(sNum, Len(sNum) - 3)
        If CInt(sDec) <> 0 Then
            sDec = "and " & Trim(HundredsToText(CVar(sDec)) & " " & sCent)
        Else
            sDec = ""
        End If
    End If
   
    IC = 0
    While Len(sNum) > 0
        sHun = Right(sNum, 3)
        sNum = Left(sNum, Application.Max(Len(sNum) - 3, 0))
        If CInt(sHun) <> 0 Then
            Result = Trim(Trim(HundredsToText(CVar(sHun)) & " " & TMBT(IC)) & " " & Result)
        End If
        IC = IC + 1
    Wend
    Result = Trim(Result & " " & sCurName)
    Result = Trim(Result & " " & sDec)
   
    NumberToText = Result
   
End Function

Private Function HundredsToText(Num As Integer) As String
    Dim Units As Variant, Teens As Variant, Tens As Variant
    Dim i As Integer, IUnit As Integer, ITen As Integer, IHundred As Integer
    Dim Result As String
   
    Units = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Teens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    Tens = Array("", "", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
   
    Result = ""
    IUnit = Num Mod 10
    i = Int(Num / 10)
    ITen = i Mod 10
    IHundred = Int(i / 10)
    If IHundred > 0 Then
        Result = Units(IHundred) & " Hundred"
    End If
    If ITen = 1 Then
        Result = Result & " " & Teens(IUnit)
    Else
        If ITen > 1 Then
            Result = Trim(Result & " " & Tens(ITen) & " " & Units(IUnit))
        Else
            Result = Trim(Result & " " & Units(IUnit))
        End If
    End If
   
    HundredsToText = Result
   
End Function

hmmm... jooo.

Nu har jeg prøvet at læse den ind i Excel og rettet så meget til som jeg kan. Men den læser stadig tallene som en englænder vil gøre det.

F.eks tallet 21, vil vi læse som "enogtyve", mens en englænder vil læse det som "tyveogen"!

Det er også det der sker når jeg prøver at fører det ind i et Excel skema med beløb.

Men det er da en start.
Er der andre som har et forslag eller en kode der virker?

Jeg faldt over den her kode, som en herinde fra engang lavede.
Hvis den kunne ændres til at gå op til 999.999.999 i stedet for 999.999 som den kan nu, er den perfekt. Jeg har rettet den lidt til, så hele teksten står sammenhængende.

Så det eneste jeg skal have hjælp med er at kunne få den til regne op til de 999.999.999.

Public Function TalTilTekst(TalVærdi As Range, Kroner As Integer)
' Kroner angives som 0 og 1
ETTegn = Array("", "en", "to", "tre", "fire", "fem", "seks", "syv", "otte", "ni")
ToTegn = Array("", "ti", "tyve", "tredive", "fyrre", "halvtreds", "tres", "halvfjerds", "firs", "halvfems")
TeenTegn = Array("ti", "elleve", "tolv", "tretten", "fjorten", "femten", "seksten", "sytten", "atten", "nitten")
  OG = ""
  Tal = Int(TalVærdi.Value) ' heltal
  Rest = Round((TalVærdi.Value - Tal), 2) * 100 ' decimaler
If A > 2 And Right(Tal, 2) <> "00" Then OG = "og"
  A = Len(Tal)
If A > 6 Then
  TalTilTekst = "for stort et tal"
  Exit Function
End If

If A = 1 Then ' et cifrede tal
    Tegn = Left(Tal, 1)
    TalTilTekst = ETTegn(Tegn) & " " & Rest & "/00"
  Exit Function
End If

If A > 3 Then
  X = Val(Left(Tal, A - 3)) ' > 1000
  Tal1000 = Val(X)
T = Len(X)
If T > 1 Then
For T = T To 2 Step -1 ' tusinder
  Select Case T
    Case 3
      Tegn = Val(Left(X, 1))
      If Tegn = 1 Then
      Tekst = Tekst & "Ethundrede"
      Else
      Tekst = Tekst & ETTegn(Tegn) & "hundrede"
      End If
    Case 2
    If Tekst <> "" And Right(X, 2) <> 0 Then OG = "og"
      Tegn = Val(Right(X, 1))
      teen = Tegn
      Tekst1 = ETTegn(Tegn) ' 1.000-9.999
      If Tekst <> "" Then
      Tegn = Val(Mid(X, 2, 1)) ' 100.000-999.999
      Else
        Tegn = Val(Left(X, 1))
      End If
    If Tegn > 1 And Tekst1 <> "" Then
 
      Tekst = Tekst & OG & Tekst1 & "og" & (ToTegn(Tegn)) & "tusinde"
      ElseIf Tegn = 1 Then
        Tekst = Tekst & OG & TeenTegn(teen) & "tusinde"
      Else
        Tekst = Tekst & OG & ETTegn(teen) & "tusinde"
    End If
      End Select
 
Next
    Tal = Tal - (Tal1000 * 1000)
GoTo Under_tusinde
  End If
      Tegn = Val(Left(X, 1))
      Tekst = Tekst & OG & ETTegn(Tegn) & "tusinde"
    Tal = Tal - (Tal1000 * 1000)
End If

Under_tusinde:
If Tal > 0 Then
For A = Len(Tal) To 2 Step -1
Select Case A
  Case 3
    Tegn = Val(Left(Tal, 1))
    If ETTegn(Tegn) <> "" Then
    If Tegn = 1 Then
      Tekst = Tekst & "Ethundrede"
    Else
      Tekst = Tekst & ETTegn(Tegn) & "hundrede"
      End If
    End If
 
Case 2
      Tegn = Val(Right(Tal, 1))
      teen = Tegn
      Tekst1 = ETTegn(Tegn) ' 0-9
      If Tekst <> "" Then
      Tegn = Val(Mid(Tal, 2, 1)) ' 10
      Else
      Tegn = Val(Left(Tal, 1)) ' 10
      End If
    If Tegn > 1 And Tekst1 <> "" Then
          Tekst = Tekst & OG & Tekst1 & "og" & ToTegn(Tegn)
    ElseIf Tegn = 1 Then
        Tekst = Tekst & "og" & TeenTegn(teen)
      Else
      Tekst = Tekst & "og" & ETTegn(teen)
      End If
End Select
Next
If Len(Tal) = 1 Then
OG = "og "
Tegn = Val(Right(Tal, 1))
Tekst = Tekst & OG & ETTegn(Tegn)
End If
End If
Tekst = Tekst & " " & Rest & "/00"
l = Len(Tekst)
Tekst = UCase(Left(Tekst, 1)) & LCase(Right(Tekst, l - 1))
If Kroner = 1 Then
TalTilTekst = Tekst & " Kroner"
Else
  TalTilTekst = Tekst
End If
End Function