Funció per convertir al català números en lletres utilitzant codi VBA des d’Access

Per convertir al català números en lletres podeu utilitzar la següent funció, escrita originalment per convertir al castellà números en lletres i que he adaptat perquè ho faci en català. El codi original l'he extret d'aportacions publicades a Internet.

Per utilitzar aquesta funció l'heu de guardar en un mòdul d'Access i després cridar-la des d'un quadre de text en un informe utilitzant com a paràmetre l'import informant en un altre quadre de text del mateix informe.

En la vista disseny quedaria així:

En la vista informe quedaria així:

Podeu descarregar el fitxer d'exemple: Exemple convertir números a lletres.accdb

En aquest exemple també trobareu el codi per convertir al castellà números a lletres 

El codi de la funció que hem d'introduir en el mòdul és:

 Function CONVIERTEEUROSCAT(ByVal NUM As Variant) As String
    Dim C As String: C = ""
    Dim A As Double
    Dim Un As Byte
    Dim De As Byte
    Dim Ce As Byte
    Dim Un_Ma As Byte
    Dim De_Ma As Byte
    Dim Ce_Ma As Byte
    Dim Un_Mo As Byte
    Dim De_Mo As Byte
    Dim Ce_Mo As Byte
    Dim Un_Ma_Mo As Byte
    Dim De_Ma_Mo As Byte
    Dim Ce_Ma_Mo As Byte
    Dim G As String 'genero.
     
    Dim A2 As String
    Dim F As Double
    Dim D As String
    Dim BO As Boolean
    Dim Deci As String
    Dim Ente As String
    Dim Bo_Deci As Boolean
    Dim AD As Double
    Dim Un_De As Byte
    Dim De_De As Byte
    Dim Ce_De As Byte
     
    Dim E As String
    Dim Ant_D As String
    
    Rem adaptación del programa a un entorno externo
    Dim Moneda_Programa As String 'Eur/Pts
    Moneda_Programa = "Eur"

    Rem adaptación del programa a un entorno externo
    NUM = CONTROL_CDEC(NUM)
   
    Select Case Moneda_Programa
        Case "Pts"
            G = "a"
            NUM = Round(NUM)
        Case "Eur"
            G = ""
    End Select
   
    A2 = CStr(NUM)
    Ente = ""
    Deci = ""
    BO = False
    Bo_Deci = False
   
    For F = 1 To Len(A2)
        D = Mid(A2, F, 1)
        If D = "." Then D = ","
        If D = "," Then BO = True: D = "": Bo_Deci = True
        Select Case BO
            Case False
            Ente = Ente + D
            Case True
            Deci = Deci + D
        End Select
    Next F
   
    If Len(Deci) > 3 Then Deci = Left(LTrim(Deci), 3)
    A = CDbl(Ente)
    If Bo_Deci = True Then AD = CDbl(Deci)
    If A > 999999999999# Then CONVIERTEEUROSCAT = CStr(NUM): Exit Function
    
    '
    Un = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    De = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    Ce = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
'
    '
    Un_Ma = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    De_Ma = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    Ce_Ma = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    '
    '
    Un_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    De_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    Ce_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
'
    '
    Un_Ma_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    De_Ma_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    '
    Ce_Ma_Mo = Right("0" + CStr(A), 1)
    A = Int(A / 10)
    '
    
    C = ""
    
    '
   
    Select Case Ce_Ma_Mo
        Case 1
            If (Un_Ma_Mo = 0 And De_Ma_Mo = 0) Then
                C = C + "cent mil"
            Else
                C = C + "cent"
            End If
        Case 2
            C = C + "dos-cents"
        Case 3
            C = C + "tres-cents"
        Case 4
            C = C + "quatre-cents"
        Case 5
            C = C + "cinc-cents"
        Case 6
            C = C + "sis-cents"
        Case 7
            C = C + "set-cents"
        Case 8
            C = C + "vuit-cents"
        Case 9
            C = C + "nou-cents"
    End Select
   
    If Ce_Ma_Mo > 1 And (De_Ma_Mo = 0 And Un_Ma_Mo = 0) Then
        C = C + " mil"
    End If
   
   '
   
   '
   
    Select Case De_Ma_Mo
        Case 1
           If Un_Ma_Mo <> 0 Then
           If De_Ma_Mo = 1 And Un_Ma_Mo = 1 Then C = C + " once mil"
           If De_Ma_Mo = 1 And Un_Ma_Mo = 2 Then C = C + " dotze mil"
           If De_Ma_Mo = 1 And Un_Ma_Mo = 3 Then C = C + " tretze mil"
           If De_Ma_Mo = 1 And Un_Ma_Mo = 4 Then C = C + " catorze mil"
           If De_Ma_Mo = 1 And Un_Ma_Mo = 5 Then C = C + " quinze mil"
           If De_Ma_Mo = 1 And Un_Ma_Mo > 5 Then C = C + " di"
           Else
               C = C + " deu mil"
           End If
        Case 2
           If Un_Ma_Mo <> 0 Then
               C = C + " vint-i-"
           Else
               C = C + " vint mil"
           End If
        Case 3
           If Un_Ma_Mo <> 0 Then
               C = C + " trenta"
           Else
               C = C + " trenta mil"
           End If
        Case 4
           If Un_Ma_Mo <> 0 Then
               C = C + " quaranta"
           Else
               C = C + " quaranta mil"
           End If
        Case 5
           If Un_Ma_Mo <> 0 Then
               C = C + " cincuanta"
           Else
               C = C + " cincuanta mil"
           End If
        Case 6
           If Un_Ma_Mo <> 0 Then
                C = C + " seixanta"
           Else
               C = C + " seixanta mil"
           End If
        Case 7
           If Un_Ma_Mo <> 0 Then
               C = C + " setanta"
           Else
               C = C + " setanta mil"
           End If
        Case 8
           If Un_Ma_Mo <> 0 Then
               C = C + " vuitanta"
           Else
               C = C + " vuitanta mil"
           End If
        Case 9
           If Un_Ma_Mo <> 0 Then
               C = C + " noranta"
           Else
               C = C + " noranta mil"
           End If
    End Select
   
    '

    '
    
    '
    If De_Ma_Mo = 1 And Un_Ma_Mo = 1 Then GoTo SaltaUnidades_Millar_Millon '11
    If De_Ma_Mo = 1 And Un_Ma_Mo = 2 Then GoTo SaltaUnidades_Millar_Millon '12
    If De_Ma_Mo = 1 And Un_Ma_Mo = 3 Then GoTo SaltaUnidades_Millar_Millon '13
    If De_Ma_Mo = 1 And Un_Ma_Mo = 4 Then GoTo SaltaUnidades_Millar_Millon '14
    If De_Ma_Mo = 1 And Un_Ma_Mo = 5 Then GoTo SaltaUnidades_Millar_Millon '15
    
    'PREFIJOS
    If (De_Ma_Mo > 2 And Un_Ma_Mo <> 0) Then C = C + "-"
    If (De_Ma_Mo <= 2 And (Un_Ma_Mo <> 0 And De_Ma_Mo <> 0)) Then C = C + ""
    '
   
    Select Case Un_Ma_Mo
        Case 1
           If (De_Ma_Mo = 0 And Ce_Ma_Mo = 0) Then
               C = C + " mil"
           Else
               C = C + "un mil"
           End If
        Case 2
           C = C + "dos mil"
        Case 3
           C = C + "tres mil"
        Case 4
           C = C + "quatre mil"
        Case 5
           C = C + "cinc mil"
        Case 6
           C = C + "sis mil"
        Case 7
           C = C + "set mil"
        Case 8
           C = C + "vuit mil"
        Case 9
           C = C + "nou mil"
    End Select
  
SaltaUnidades_Millar_Millon:
    '
   
    '
   
    'PREFIJO
    C = C + " " 'espacio para las unidades de millar de millon
   
    Select Case Ce_Mo
        Case 1
           If (Un_Mo = 0 And De_Mo = 0) Then
               C = C + "cent"
           Else
               C = C + "cent "
           End If
        Case 2
           C = C + "dos-cents"
        Case 3
           C = C + "tres-cents"
        Case 4
           C = C + "quatre-cents"
        Case 5
           C = C + "cinc-cents"
        Case 6
           C = C + "sis-cents"
        Case 7
           C = C + "set-cents"
        Case 8
           C = C + "vuit-cents"
        Case 9
           C = C + "nou-cents"
    End Select
   
    '
   
    '
   
    'PREFIJO
    C = C + " " 'espacio para las centenas
   
    Select Case De_Mo
        Case 1
           If Un_Mo <> 0 Then
           If De_Mo = 1 And Un_Mo = 1 Then C = C + "onze"
           If De_Mo = 1 And Un_Mo = 2 Then C = C + "dotze"
           If De_Mo = 1 And Un_Mo = 3 Then C = C + "tretze"
           If De_Mo = 1 And Un_Mo = 4 Then C = C + "catorze"
           If De_Mo = 1 And Un_Mo = 5 Then C = C + "quinze"
           If De_Mo = 1 And Un_Mo > 5 Then C = C + "di"
           Else
               C = C + "deu"
           End If
        Case 2
           If Un_Mo <> 0 Then
               C = C + "vint"
           Else
               C = C + "vint-i-"
           End If
        Case 3
           C = C + "trenta"
        Case 4
           C = C + "quaratna"
        Case 5
           C = C + "cinquanta"
        Case 6
           C = C + "seixanta"
        Case 7
           C = C + "setanta"
        Case 8
           C = C + "vuitanta"
        Case 9
           C = C + "noranta"
    End Select
   
    '
   
    '
     
    '
    If De_Mo = 1 And Un_Mo = 1 Then GoTo SaltaUnidades_Millon '11
    If De_Mo = 1 And Un_Mo = 2 Then GoTo SaltaUnidades_Millon '12
    If De_Mo = 1 And Un_Mo = 3 Then GoTo SaltaUnidades_Millon '13
    If De_Mo = 1 And Un_Mo = 4 Then GoTo SaltaUnidades_Millon '14
    If De_Mo = 1 And Un_Mo = 5 Then GoTo SaltaUnidades_Millon '15
    
    'PREFIJOS
    If (De_Mo > 2 And Un_Mo <> 0) Then C = C + "-"
    If (De_Mo <= 2 And (Un_Mo <> 0 And De_Mo <> 0)) Then C = C + ""
    
    '
   
    Select Case Un_Mo
        Case 1
           C = C + "un"
           If Ce_Mo = 0 And De_Mo = 0 Then C = C + " milió"
        Case 2
           C = C + "dos"
        Case 3
           C = C + "tres"
        Case 4
           C = C + "quatre"
        Case 5
           C = C + "cinc"
        Case 6
           C = C + "seis"
        Case 7
           C = C + "set"
        Case 8
           C = C + "vuit"
        Case 9
           C = C + "nou"
    End Select
  
SaltaUnidades_Millon:
    '
   
    If NUM > 999999 Then
        If Un_Mo = 1 And (De_Mo = 0 And Ce_Mo = 0 And Un_Ma_Mo = 0 And De_Ma_Mo = 0 And Ce_Ma_Mo = 0) Then 'solo 1 millon        C = C + " millón"
        Else
            C = C + " milions"
        End If
    End If

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
   
    '
   
    'PREFIJO
    C = C + " " 'espacio para las unidades de millon
   
    Select Case Ce_Ma
        Case 1
           If (Un_Ma = 0 And De_Ma = 0) Then
               C = C + "cent mil"
           Else
               C = C + "cent"
           End If
        Case 2
           C = C + "dos-cents" + G + "" 'genero
        Case 3
           C = C + "tres-cents" + G + "" 'genero
        Case 4
           C = C + "quatre-cents" + G + "" 'genero
        Case 5
           C = C + "cinc-cents" + G + "" 'genero
        Case 6
           C = C + "sis-cents" + G + "" 'genero
        Case 7
           C = C + "set-cents" + G + "" 'genero
        Case 8
           C = C + "vuit-cents" + G + "" 'genero
        Case 9
           C = C + "nou-cents" + G + "" 'genero
    End Select
   
    If Ce_Ma > 1 And (De_Ma = 0 And Un_Ma = 0) Then
        C = C + " mil"
    End If
   
    '
   
    '
   
    Select Case De_Ma
        Case 1
           If Un_Ma <> 0 Then
           If De_Ma = 1 And Un_Ma = 1 Then C = C + " onze mil"
           If De_Ma = 1 And Un_Ma = 2 Then C = C + " dotze mil"
           If De_Ma = 1 And Un_Ma = 3 Then C = C + " tretze mil"
           If De_Ma = 1 And Un_Ma = 4 Then C = C + " catorze mil"
           If De_Ma = 1 And Un_Ma = 5 Then C = C + " quinze mil"
           If De_Ma = 1 And Un_Ma > 5 Then C = C + " di"
           Else
               C = C + " deu mil"
           End If
        Case 2
           If Un_Ma <> 0 Then
               C = C + " vint-i-"
           Else
               C = C + " vint mil"
           End If
        Case 3
           If Un_Ma <> 0 Then
               C = C + " trenta"
           Else
               C = C + " trenta mil"
           End If
        Case 4
           If Un_Ma <> 0 Then
               C = C + " quaranta"
           Else
               C = C + " quaranta mil"
           End If
        Case 5
           If Un_Ma <> 0 Then
               C = C + " cincuanta"
           Else
               C = C + " cincuanta mil"
           End If
        Case 6
           If Un_Ma <> 0 Then
               C = C + " setanta"
           Else
               C = C + " setanta mil"
           End If
        Case 7
           If Un_Ma <> 0 Then
               C = C + " setanta"
           Else
               C = C + " setanta mil"
           End If
        Case 8
           If Un_Ma <> 0 Then
               C = C + " vuitanta"
           Else
               C = C + " vuitanta mil"
           End If
        Case 9
           If Un_Ma <> 0 Then
               C = C + " noranta"
           Else
               C = C + " noranta mil"
           End If
    End Select
   
    '
   
    '
    
    '
    If De_Ma = 1 And Un_Ma = 1 Then GoTo SaltaUnidades_Millar '11
    If De_Ma = 1 And Un_Ma = 2 Then GoTo SaltaUnidades_Millar '12
    If De_Ma = 1 And Un_Ma = 3 Then GoTo SaltaUnidades_Millar '13
    If De_Ma = 1 And Un_Ma = 4 Then GoTo SaltaUnidades_Millar '14
    If De_Ma = 1 And Un_Ma = 5 Then GoTo SaltaUnidades_Millar '15
    
    'PREFIJOS
    If (De_Ma > 2 And Un_Ma <> 0) Then C = C + "-"
    If (De_Ma <= 2 And (Un_Ma <> 0 And De_Ma <> 0)) Then C = C + ""
    '
   
    Select Case Un_Ma
        Case 1
           If (De_Ma = 0 And Ce_Ma = 0) Then
               C = C + " mil"
           Else
                If G = "o" Then
                    C = C + "un mil"
                Else
                    C = C + "unamil"
                End If
           End If
        Case 2
           C = C + "dos mil"
        Case 3
           C = C + "tres mil"
        Case 4
           C = C + "quatre mil"
        Case 5
           C = C + "cinc mil"
        Case 6
           C = C + "sis mil"
        Case 7
           C = C + "set mil"
        Case 8
           C = C + "vuit mil"
        Case 9
           C = C + "nou mil"
    End Select
  
SaltaUnidades_Millar:
    '
   
    '
   
    'PREFIJO
    C = C + " " 'espacio para las unidades de millar
   
    Select Case Ce
        Case 1
           If (Un = 0 And De = 0) Then
               C = C + "cent"
           Else
               C = C + "cent"
           End If
        Case 2
           C = C + "dos-cents" + G + "" 'genero
        Case 3
           C = C + "tres-cents" + G + "" 'genero
        Case 4
           C = C + "quatre-cents" + G + "" 'genero
        Case 5
           C = C + "cinc-cents" + G + "" 'genero
        Case 6
           C = C + "sis-cents" + G + "" 'genero
        Case 7
           C = C + "set-cents" + G + "" 'genero
        Case 8
           C = C + "vuit-cents" + G + "" 'genero
        Case 9
           C = C + "nou-cents" + G + "" 'genero
    End Select
   
    '
   
    '
    
    'PREFIJO
    C = C + " " 'espacio para las centenas
   
    Select Case De
        Case 1
           If Un <> 0 Then
           If De = 1 And Un = 1 Then C = C + "once"
           If De = 1 And Un = 2 Then C = C + "dotze"
           If De = 1 And Un = 3 Then C = C + "tretze"
           If De = 1 And Un = 4 Then C = C + "catorze"
           If De = 1 And Un = 5 Then C = C + "quinze"
           If De = 1 And Un > 5 Then C = C + "di"
           Else
               C = C + "deu"
           End If
        Case 2
           If Un <> 0 Then
               C = C + "vint-i-"
           Else
               C = C + "vint"
           End If
        Case 3
           C = C + "trenta"
        Case 4
           C = C + "quaranta"
        Case 5
           C = C + "cincuanta"
        Case 6
           C = C + "seixanta"
        Case 7
           C = C + "setanta"
        Case 8
           C = C + "vuitanta"
        Case 9
           C = C + "noranta"
    End Select
   
    '
   
    '
     
    '
    If De = 1 And Un = 1 Then GoTo SaltaUnidades '11
    If De = 1 And Un = 2 Then GoTo SaltaUnidades '12
    If De = 1 And Un = 3 Then GoTo SaltaUnidades '13
    If De = 1 And Un = 4 Then GoTo SaltaUnidades '14
    If De = 1 And Un = 5 Then GoTo SaltaUnidades '15
    
    'PREFIJOS
    If (De > 2 And Un <> 0) Then C = C + "-"
    If (De <= 2 And (Un <> 0 And De <> 0)) Then C = C + ""
    
    '
   
    Select Case Un
        Case 1
           If G <> "o" Then
               C = C + "un" + G 'genero
           Else
               C = C + "un"
           End If
        Case 2
           C = C + "dos"
        Case 3
           C = C + "tres"
        Case 4
           C = C + "quatre"
        Case 5
           C = C + "cinc"
        Case 6
           C = C + "sis"
        Case 7
           C = C + "set"
        Case 8
           C = C + "vuit"
        Case 9
           C = C + "nou"
    End Select
  
SaltaUnidades:
    '
   
    '
   
    'CERO
    If CDbl(Ente) = 0 Then C = "zero"
   
    '
   
    '
    If Bo_Deci = True Then GoSub DECIMALES_Sub
    '
   
    GoSub ELIMINAR_ESPACIOS
    
    If Moneda_Programa = "Eur" Then
        If Int(NUM) = NUM Then C = C + " euros" Else C = C + " cèntims"
    Else
        C = C + " Pts."
    End If
    
    C = LTrim(RTrim(C))
    
    If C = "un euros" Then C = "un euro"
    If C = "un céntimos" Then C = "un cèntim"
    
    If Left(C + Space(Len("un euros")), Len("un euros")) = "un euros" Then
        C = "un euro" + Right(C, Len(C) - Len("un euros"))
    End If
    
    If Right(Space(Len("uno céntimos")) + C, Len("uno céntimos")) = "un cèntims" Then
        C = Left(C, Len(C) - Len("un cèntims")) + "un cèntims"
    End If

    If Right(Space(Len("amb un cèntims")) + C, Len("amb un cèntims")) = "amb un cèntims" Then
        C = Left(C, Len(C) - Len("amb un cèntims")) + "amb un cèntims"
    End If
    
    CONVIERTEEUROSCAT = C

Exit Function
'######################################
'#########  SUBRUTINAS  ###############
'######################################
DECIMALES_Sub:

    Dim Bo1 As Boolean 'salta centenas
    Dim Bo2 As Boolean 'salda decenas
    
    Bo1 = False
    Bo2 = False
    
    Deci = Left(Deci + "00", 2)
      
    If Val(Deci) = 0 Then Return
         
    If Len(Deci) = 1 Then Deci = Deci + "0"
    If Val(Deci) > 0 Then Bo1 = True
    
    '
    Un_De = Mid(Deci + "00", 2, 1)
    '
    
    '
    De_De = Left(Deci + "0", 1)
    '
    
    C = C + " euros amb  "
    
    '
    If Bo2 = True Then GoTo SDecenas
    
    Select Case De_De
      Case 0
         C = C + ""
      Case 1
         If Un_De <> 0 Then
         If De_De = 1 And Un_De = 1 Then C = C + "onze"
         If De_De = 1 And Un_De = 2 Then C = C + "dotze"
         If De_De = 1 And Un_De = 3 Then C = C + "tretze"
         If De_De = 1 And Un_De = 4 Then C = C + "catorze"
         If De_De = 1 And Un_De = 5 Then C = C + "quinze"
         If De_De = 1 And Un_De > 5 Then C = C + "di"
         Else
             C = C + "deu"
         End If
      Case 2
         If Un_De <> 0 Then
             C = C + "vint-i-"
         Else
             C = C + "vint"
         End If
      Case 3
         C = C + "trenta"
      Case 4
         C = C + "quaranta"
      Case 5
         C = C + "cincuanta"
      Case 6
         C = C + "seixanta"
      Case 7
         C = C + "setanta"
      Case 8
         C = C + "vuitanta"
      Case 9
         C = C + "noranta"
    End Select
SDecenas:
    '
   
    '
     
    '
    If De_De = 1 And Un_De = 1 Then GoTo SaltaUnidades_Decimal '11
    If De_De = 1 And Un_De = 2 Then GoTo SaltaUnidades_Decimal '12
    If De_De = 1 And Un_De = 3 Then GoTo SaltaUnidades_Decimal '13
    If De_De = 1 And Un_De = 4 Then GoTo SaltaUnidades_Decimal '14
    If De_De = 1 And Un_De = 5 Then GoTo SaltaUnidades_Decimal '15
    
    'PREFIJOS
    If (De_De > 2 And Un_De <> 0) Then C = C + "-"
    If (De_De <= 2 And (Un_De <> 0 And De_De <> 0)) Then C = C + ""
    
    '
   
    Select Case Un_De
      Case 1
         C = C + "un" + G 'genero
      Case 2
         C = C + "dos"
      Case 3
         C = C + "tres"
      Case 4
         C = C + "quatre"
      Case 5
         C = C + "cinc"
      Case 6
         C = C + "sis"
      Case 7
         C = C + "set"
      Case 8
         C = C + "vui"
      Case 9
         C = C + "nou"
    End Select

SaltaUnidades_Decimal:
    '

    Return

ELIMINAR_ESPACIOS:
    D = ""
    E = ""
    For F = 1 To Len(C)
        D = Mid(C, F, 1)
        BO = False
        If (Ant_D = " " And D = " ") Then D = "": BO = True
        If BO = False Then Ant_D = D
        E = E + D
    Next F
    C = E
    Return
End Function

Private Function CONTROL_CDEC(ByVal NUM As Variant) As Variant
    On Error GoTo TRATAMIENTO
    GoTo INICIO
TRATAMIENTO:
    CONTROL_CDEC = 0
    Exit Function
INICIO:
    CONTROL_CDEC = CDec(NUM)
End Function