Moderatori: Dylan666, hydra, gahan
' Convert an integer into an English string
Function english(ByVal N As Long) As String
Const Thousand = 1000&
Const Million = Thousand * Thousand
Const Billion = Thousand * Million
'Const Trillion = Thousand * Billion
Dim Buf As String: Buf = ""
Application.Volatile True
If (N = 0) Then english = "zero": Exit Function
If (N < 0) Then Buf = "negative ": N = -N
If (N >= Billion) Then
Buf = Buf & EnglishDigitGroup(N \ Billion) & " billion"
N = N Mod Billion
If (N) Then Buf = Buf & " "
End If
If (N >= Million) Then
Buf = Buf & EnglishDigitGroup(N \ Million) & " million"
N = N Mod Million
If (N) Then Buf = Buf & " "
End If
If (N >= Thousand) Then
Buf = Buf & EnglishDigitGroup(N \ Thousand) & " thousand"
N = N Mod Thousand
If (N) Then Buf = Buf & " "
End If
If (N > 0) Then
Buf = Buf & EnglishDigitGroup(N)
End If
english = Buf
End Function
' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal N As Integer) As String
Const Hundred = " hundred"
Const One = "one"
Const Two = "two"
Const Three = "three"
Const Four = "four"
Const Five = "five"
Const Six = "six"
Const Seven = "seven"
Const Eight = "eight"
Const Nine = "nine"
Dim Buf As String: Buf = ""
Dim Flag As Integer: Flag = False
'Do hundreds
Select Case (N \ 100)
Case 0: Buf = "": Flag = False
Case 1: Buf = One & Hundred: Flag = True
Case 2: Buf = Two & Hundred: Flag = True
Case 3: Buf = Three & Hundred: Flag = True
Case 4: Buf = Four & Hundred: Flag = True
Case 5: Buf = Five & Hundred: Flag = True
Case 6: Buf = Six & Hundred: Flag = True
Case 7: Buf = Seven & Hundred: Flag = True
Case 8: Buf = Eight & Hundred: Flag = True
Case 9: Buf = Nine & Hundred: Flag = True
End Select
If (Flag) Then N = N Mod 100
If (N) Then
If (Flag) Then Buf = Buf & " "
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do tens (except teens)
Select Case (N \ 10)
Case 0, 1: Flag = False
Case 2: Buf = Buf & "twenty": Flag = True
Case 3: Buf = Buf & "thirty": Flag = True
Case 4: Buf = Buf & "forty": Flag = True
Case 5: Buf = Buf & "fifty": Flag = True
Case 6: Buf = Buf & "sixty": Flag = True
Case 7: Buf = Buf & "seventy": Flag = True
Case 8: Buf = Buf & "eighty": Flag = True
Case 9: Buf = Buf & "ninety": Flag = True
End Select
If (Flag) Then N = N Mod 10
If (N) Then
If (Flag) Then Buf = Buf & "-"
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do ones and teens
Select Case (N)
Case 0: ' do nothing
Case 1: Buf = Buf & One
Case 2: Buf = Buf & Two
Case 3: Buf = Buf & Three
Case 4: Buf = Buf & Four
Case 5: Buf = Buf & Five
Case 6: Buf = Buf & Six
Case 7: Buf = Buf & Seven
Case 8: Buf = Buf & Eight
Case 9: Buf = Buf & Nine
Case 10: Buf = Buf & "ten"
Case 11: Buf = Buf & "eleven"
Case 12: Buf = Buf & "twelve"
Case 13: Buf = Buf & "thirteen"
Case 14: Buf = Buf & "fourteen"
Case 15: Buf = Buf & "fifteen"
Case 16: Buf = Buf & "sixteen"
Case 17: Buf = Buf & "seventeen"
Case 18: Buf = Buf & "eighteen"
Case 19: Buf = Buf & "nineteen"
End Select
EnglishDigitGroup = Buf
End Function
Hai provato?caponord ha scritto:1. quindi il modulo resta memorizzato senza che debba fare nulla d'altro?
Prova:caponord ha scritto:2. pensi sia possibile che non ci siano "spaziature" tra una parola e l'altra?
' Convert an integer into an English string
Function english(ByVal N As Long) As String
Const Thousand = 1000&
Const Million = Thousand * Thousand
Const Billion = Thousand * Million
'Const Trillion = Thousand * Billion
Dim Buf As String: Buf = ""
Application.Volatile True
If (N = 0) Then english = "zero": Exit Function
If (N < 0) Then Buf = "negative ": N = -N
If (N >= Billion) Then
Buf = Buf & EnglishDigitGroup(N \ Billion) & "billion"
N = N Mod Billion
End If
If (N >= Million) Then
Buf = Buf & EnglishDigitGroup(N \ Million) & "million"
N = N Mod Million
End If
If (N >= Thousand) Then
Buf = Buf & EnglishDigitGroup(N \ Thousand) & "thousand"
N = N Mod Thousand
End If
If (N > 0) Then
Buf = Buf & EnglishDigitGroup(N)
End If
english = Buf
End Function
' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal N As Integer) As String
Const Hundred = "hundred"
Const One = "one"
Const Two = "two"
Const Three = "three"
Const Four = "four"
Const Five = "five"
Const Six = "six"
Const Seven = "seven"
Const Eight = "eight"
Const Nine = "nine"
Dim Buf As String: Buf = ""
Dim Flag As Integer: Flag = False
'Do hundreds
Select Case (N \ 100)
Case 0: Buf = "": Flag = False
Case 1: Buf = One & Hundred: Flag = True
Case 2: Buf = Two & Hundred: Flag = True
Case 3: Buf = Three & Hundred: Flag = True
Case 4: Buf = Four & Hundred: Flag = True
Case 5: Buf = Five & Hundred: Flag = True
Case 6: Buf = Six & Hundred: Flag = True
Case 7: Buf = Seven & Hundred: Flag = True
Case 8: Buf = Eight & Hundred: Flag = True
Case 9: Buf = Nine & Hundred: Flag = True
End Select
If (Flag) Then N = N Mod 100
If (N) Then
'If (Flag) Then Buf = Buf & " "
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do tens (except teens)
Select Case (N \ 10)
Case 0, 1: Flag = False
Case 2: Buf = Buf & "twenty": Flag = True
Case 3: Buf = Buf & "thirty": Flag = True
Case 4: Buf = Buf & "forty": Flag = True
Case 5: Buf = Buf & "fifty": Flag = True
Case 6: Buf = Buf & "sixty": Flag = True
Case 7: Buf = Buf & "seventy": Flag = True
Case 8: Buf = Buf & "eighty": Flag = True
Case 9: Buf = Buf & "ninety": Flag = True
End Select
If (Flag) Then N = N Mod 10
If (N) Then
If (Flag) Then Buf = Buf & "-"
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do ones and teens
Select Case (N)
Case 0: ' do nothing
Case 1: Buf = Buf & One
Case 2: Buf = Buf & Two
Case 3: Buf = Buf & Three
Case 4: Buf = Buf & Four
Case 5: Buf = Buf & Five
Case 6: Buf = Buf & Six
Case 7: Buf = Buf & Seven
Case 8: Buf = Buf & Eight
Case 9: Buf = Buf & Nine
Case 10: Buf = Buf & "ten"
Case 11: Buf = Buf & "eleven"
Case 12: Buf = Buf & "twelve"
Case 13: Buf = Buf & "thirteen"
Case 14: Buf = Buf & "fourteen"
Case 15: Buf = Buf & "fifteen"
Case 16: Buf = Buf & "sixteen"
Case 17: Buf = Buf & "seventeen"
Case 18: Buf = Buf & "eighteen"
Case 19: Buf = Buf & "nineteen"
End Select
EnglishDigitGroup = Buf
End Function
' Convert an integer into an English string
Function english(ByVal dbl As Double) As String
Const Thousand = 1000&
Const Million = Thousand * Thousand
Const Billion = Thousand * Million
'Const Trillion = Thousand * Billion
Dim Buf As String: Buf = ""
Dim N As Long
Dim dec As String: dec = ""
Application.Volatile True
If (dbl = 0) Then english = "zero": Exit Function
If (dbl < 0) Then Buf = "negative "
N = Int(Abs(dbl))
dec = Mid(CStr(dbl), InStr(CStr(dbl) & ",", ",") + 1)
If (N >= Billion) Then
Buf = Buf & EnglishDigitGroup(N \ Billion) & "billion"
N = N Mod Billion
'If (N) Then Buf = Buf & " "
End If
If (N >= Million) Then
Buf = Buf & EnglishDigitGroup(N \ Million) & "million"
N = N Mod Million
'If (N) Then Buf = Buf & " "
End If
If (N >= Thousand) Then
Buf = Buf & EnglishDigitGroup(N \ Thousand) & "thousand"
N = N Mod Thousand
'If (N) Then Buf = Buf & " "
End If
If (N > 0) Then
Buf = Buf & EnglishDigitGroup(N)
End If
If (dec > "") Then
Buf = Buf & "/" & dec
End If
english = Buf
End Function
' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal N As Integer) As String
Const Hundred = "hundred"
Const One = "one"
Const Two = "two"
Const Three = "three"
Const Four = "four"
Const Five = "five"
Const Six = "six"
Const Seven = "seven"
Const Eight = "eight"
Const Nine = "nine"
Dim Buf As String: Buf = ""
Dim Flag As Integer: Flag = False
'Do hundreds
Select Case (N \ 100)
Case 0: Buf = "": Flag = False
Case 1: Buf = One & Hundred: Flag = True
Case 2: Buf = Two & Hundred: Flag = True
Case 3: Buf = Three & Hundred: Flag = True
Case 4: Buf = Four & Hundred: Flag = True
Case 5: Buf = Five & Hundred: Flag = True
Case 6: Buf = Six & Hundred: Flag = True
Case 7: Buf = Seven & Hundred: Flag = True
Case 8: Buf = Eight & Hundred: Flag = True
Case 9: Buf = Nine & Hundred: Flag = True
End Select
If (Flag) Then N = N Mod 100
If (N) Then
'If (Flag) Then Buf = Buf & " "
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do tens (except teens)
Select Case (N \ 10)
Case 0, 1: Flag = False
Case 2: Buf = Buf & "twenty": Flag = True
Case 3: Buf = Buf & "thirty": Flag = True
Case 4: Buf = Buf & "forty": Flag = True
Case 5: Buf = Buf & "fifty": Flag = True
Case 6: Buf = Buf & "sixty": Flag = True
Case 7: Buf = Buf & "seventy": Flag = True
Case 8: Buf = Buf & "eighty": Flag = True
Case 9: Buf = Buf & "ninety": Flag = True
End Select
If (Flag) Then N = N Mod 10
If (N) Then
If (Flag) Then Buf = Buf & "-"
Else
EnglishDigitGroup = Buf
Exit Function
End If
'Do ones and teens
Select Case (N)
Case 0: ' do nothing
Case 1: Buf = Buf & One
Case 2: Buf = Buf & Two
Case 3: Buf = Buf & Three
Case 4: Buf = Buf & Four
Case 5: Buf = Buf & Five
Case 6: Buf = Buf & Six
Case 7: Buf = Buf & Seven
Case 8: Buf = Buf & Eight
Case 9: Buf = Buf & Nine
Case 10: Buf = Buf & "ten"
Case 11: Buf = Buf & "eleven"
Case 12: Buf = Buf & "twelve"
Case 13: Buf = Buf & "thirteen"
Case 14: Buf = Buf & "fourteen"
Case 15: Buf = Buf & "fifteen"
Case 16: Buf = Buf & "sixteen"
Case 17: Buf = Buf & "seventeen"
Case 18: Buf = Buf & "eighteen"
Case 19: Buf = Buf & "nineteen"
End Select
EnglishDigitGroup = Buf
End Function
Dylan666 ha scritto:In tette
archimede ha scritto:Se non vuoi il trattino metti un apice singolo davanti a 'If (Flag) Then Buf = Buf & "-".
Alessandro
caponord ha scritto:Grazie a DYLAN, nelle ricerche con i motori devo abituarmi a ragionare in inglese, perchè se cerco con "traduttore parole numeri" esce davvero poco o nulla.
Aggiungicaponord ha scritto:un solo piccolissimo dettaglio, il ",10" lo traduce in lettere in ",1" anzichè ",10".
If (Len(dec) = 1) Then dec = dec & "0"
If (dec > "") Then
formattare una colonnacon numeri senza virgolaSalve Autore: giorgioa |
Forum: Applicazioni Office Windows Risposte: 5 |
Excel: formula per aggiungere una "S" alle lettere minuscole Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 3 |
Come nascondere I Numeri non Appartenenti Al Mese Deside Autore: Maury170419 |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 28 ospiti