Originariamente inviato da dieghito101
Ciao a tutti,

sto facendo un programma in VB6 e SQL2000 e avrei il seguente problema:

qualcuno di voi ha una vaga idea di come potrei fare per leggere un numero ( scritto in cifre ) e scriverlo in lettere? un po' come si fa sugli assegni...
accettoo soluzioni sia in VB che in T-SQL!!

Grazie mille a chiunque abbia un suggerimento!
codice:
'*********************************
Dim sUnita(19)                  As String
Dim sDecina(9)                  As String

Private Sub Form_Load()

Dim N As String
N = "1234567890123,15"

MsgBox NumeroInLettere(N)
Unload Me
End Sub
'******************************************************************************
'                               NumeroToLettere
'
'                Converte il numero intero in lettere
'
' Input : ImportoN                -->Importo Numerico
'
' Ouput : NumeroToLettere         -->Il numero in lettere
'******************************************************************************
Function NumeroInLettere(Numero As String) As String
  
'************************
  'Gestisce la virgola
'************************
  Dim PosVirg                     As Integer
  Dim Lettere                     As String
  
  Numero$ = ChangeStr(Numero$, ".", "")
  PosVirg% = InStr(Numero$, ",")

  If PosVirg% Then
    Lettere$ = NumInLet(Mid(Numero$, 1, Len(Numero) + PosVirg% - 1))
    Lettere$ = Lettere$ & "\" & Format(Mid(Numero$, PosVirg% + 1, Len(Numero$)), "00")
  Else
    Lettere$ = NumInLet(CDbl(Numero$))
  End If
  
  NumeroInLettere = Lettere$

End Function

Private Function NumInLet(N As Double) As String

  '************************************************
  'inizializzo i due arry di numeri
  '************************************************
  SetNumeri
  
  Dim ValT            As Double     'Valore Temporaneo per la conversione
  Dim iCent           As Integer    'Valore su cui calcolare le centinaia
  Dim L               As String     'Importo in Lettere
    
  NumInLet = "zero"

  If N = 0 Then Exit Function

  ValT = N
  L = ""
  
  'miliardi
  iCent = Int(ValT / 1000000000#)
  If iCent Then
    If iCent = 1 Then
      L = "UnMiliardo"
    Else
      L = LCent(iCent) + "Miliardi"
    End If
    ValT = ValT - CDbl(iCent) * 1000000000#
  End If

  'milioni
  iCent = Int(ValT / 1000000#)
  If iCent Then
    If iCent = 1 Then
      L = L + "UnMilione"
    Else
      L = L + LCent(iCent) + "Milioni"
    End If
    ValT = ValT - CDbl(iCent) * 1000000#
  End If

  'miliaia
  iCent = Int(ValT / 1000)
  If iCent Then
    If iCent = 1 Then
      L = L + "Mille"
    Else
      L = L + LCent(iCent) + "mila"
    End If
    ValT = ValT - CDbl(iCent) * 1000
  End If

  'centinaia
  If ValT Then
    L = L + LCent(CInt(ValT))
  End If

  NumInLet = L

End Function

Function LCent(N As Integer) As String

  ' Ritorna xx% (1/999) convertito in lettere
  Dim Numero                        As String
  Dim Lettere                       As String
  Dim Centinaia                     As Integer
  Dim Decine                        As Integer
  Dim x                             As Integer
  Dim Unita                         As Integer
  Dim sDec                          As String
  
  Numero$ = Format(N, "000")
    
  Lettere$ = ""
  Centinaia% = Val(Left$(Numero$, 1))
  If Centinaia% Then
      If Centinaia% > 1 Then
        Lettere = sUnita(Centinaia%)
      End If
    Lettere = Lettere + "Cento"
  End If

  Decine% = (N Mod 100)
  If Decine% Then
    Select Case Decine%
      Case Is >= 20                               'Decine
        sDec = sDecina(Val(Mid$(Numero$, 2, 1)))
        x% = Len(sDec)
        Unita% = Val(Right$(Numero$, 1))          'Unita
          If Unita% = 1 Or Unita% = 8 Then x% = x% - 1
        Lettere$ = Lettere$ & Left(sDec, x%) & sUnita(Unita%)    'Tolgo l'ultima lettera della decina per i
      Case Else
        Lettere$ = Lettere$ + sUnita(Decine)
    End Select
  End If

  LCent$ = Lettere$

End Function


Sub SetNumeri()

'************************************************
' Stringhe per traslitterazione numeri
'************************************************
  sUnita(1) = "Uno"
  sUnita(2) = "Due"
  sUnita(3) = "Tre"
  sUnita(4) = "Quattro"
  sUnita(5) = "Cinque"
  sUnita(6) = "Sei"
  sUnita(7) = "Sette"
  sUnita(8) = "Otto"
  sUnita(9) = "Nove"
  sUnita(10) = "Dieci"
  sUnita(11) = "Undici"
  sUnita(12) = "Dodici"
  sUnita(13) = "Tredici"
  sUnita(14) = "Quattordici"
  sUnita(15) = "Quindici"
  sUnita(16) = "Sedici"
  sUnita(17) = "Diciassette"
  sUnita(18) = "Diciotto"
  sUnita(19) = "Diciannove"
  
  sDecina(1) = "Dieci"
  sDecina(2) = "Venti"
  sDecina(3) = "Trenta"
  sDecina(4) = "Quaranta"
  sDecina(5) = "Cinquanta"
  sDecina(6) = "Sessanta"
  sDecina(7) = "Settanta"
  sDecina(8) = "Ottanta"
  sDecina(9) = "Novanta"

End Sub

'*********************************************************************
'                ChangeStr - da usare con versioni minori del Vb6
'
'Input  = Stringa                           -->Da convertire
'         Lettera da sostituire             -->Da convertire
'         Nuova lettera da rimpiazzare      -->Da convertire
'
'Ouput  = Stringa rimpiazzata
'
'*********************************************************************
Function ChangeStr(ByRef sBuffer As String, ByRef OldChar As String, _
                   ByRef NewChar As String) As String
    
  Dim TmpBuf                      As String
  Dim p                           As Integer

On Error GoTo ErrChangeStr

  ChangeStr$ = ""   'Default Error

  TmpBuf$ = sBuffer$
  p% = InStr(TmpBuf$, OldChar$)
  Do While p > 0
    TmpBuf$ = Left$(TmpBuf$, p% - 1) + NewChar$ + Mid$(TmpBuf$, p% + Len(OldChar$))
    p% = InStr(p% + Len(NewChar$), TmpBuf$, OldChar$)
  Loop
  ChangeStr$ = TmpBuf$

Exit Function

ErrChangeStr:
  ChangeStr$ = ""

End Function