Como lograr que Macro VB EXCEL Numeros a Letras tome un dato de tipo de moneda de una celda en una hoja y lo muestre
Estimados amigos tengo la siguiente Macro para convertir números a letras y quisiera que cuando cambie el tipo de formato de moneda desde el formulario configuración tome ese valor desde una celda en la hoja DATOS del Libro y cambie el tipo de moneda según la seleccionada.
Option Explicit
Const UNI = 1, DIECI = 2, DECENA = 3, CENTENA = 4
Function NUMALET(strnuM As String) As String
Dim nuM As Double
Dim teR As Integer
Dim i As Integer
Dim numcaD As String
Dim matriZcaD(0 To 9, UNI To CENTENA) As String
Dim caDternA As String, resultadO As String
Dim centenAternA As Integer, decenAternA As Integer, unidaDternA As Integer
Dim NumeroDeternA As Byte
If IsNumeric(strnuM) Then
nuM = CDbl(Abs(strnuM))
Else
NUMALET = "#¡VALOR!"
Exit Function
End If
If nuM >= 1000000000000# Or nuM < 0 Then
NUMALET = "#¡NUM!"
Exit Function
End If
If nuM < 1 Then resultadO = " cero"
Call llenaConCadenas(matriZcaD)
numcaD = CStr(Fix(Format(nuM, "standard")))
NumeroDeternA = 0
i = Len(numcaD)
Do 'Procesa el número desde atras hacia adelante en ternas
NumeroDeternA = NumeroDeternA + 1
caDternA = "" 'Inicializa la cadena de la terna
If i >= 3 Then ' Extrae la terna
teR = Val(Mid(numcaD, i - 2, 3))
Else
teR = Val(Mid(numcaD, 1, i)) 'Cuando ya no hay una terna
End If
centenAternA = Int(teR / 100) 'centenA
decenAternA = teR - Int(teR / 100) * 100 'decena y unidad
unidaDternA = decenAternA - Int(decenAternA / 10) * 10 'solo unidad
Select Case decenAternA 'Procesa decenas y unidades
Case 1 To 9
caDternA = matriZcaD(unidaDternA, UNI) & caDternA
Case 10 To 19
caDternA = caDternA & matriZcaD(decenAternA - (Int(decenAternA / 10) * 10), DIECI)
Case 20
caDternA = caDternA & " veinte"
Case 21 To 29
caDternA = caDternA & matriZcaD(Int(decenAternA / 10), DECENA) & Mid(matriZcaD(unidaDternA, UNI), 2, Len(matriZcaD(unidaDternA, UNI)) - 1)
Case 30 To 99
If unidaDternA <> 0 Then
caDternA = matriZcaD(Int(decenAternA / 10), DECENA) _
& " y" & matriZcaD(unidaDternA, UNI) & caDternA
Else
caDternA = caDternA & matriZcaD(Int(decenAternA / 10), DECENA)
End If
End Select
Select Case centenAternA 'Procesa las centenas
Case 1
If decenAternA > 0 Then
caDternA = " ciento" & caDternA
Else
caDternA = " cien" & caDternA
End If
Case 5, 7, 9
caDternA = matriZcaD(Int(teR / 100), CENTENA) & caDternA
Case Else
If Int(teR / 100) > 1 Then caDternA = matriZcaD _
(Int(teR / 100), UNI) & "cientos" & caDternA
End Select
If unidaDternA = 1 And NumeroDeternA > 1 And decenAternA <> 11 Then caDternA = Mid(caDternA, 1, Len(caDternA) - 1)
Select Case NumeroDeternA 'Según el número de terna agrega la unidad
Case 3
If nuM < 2000000 Then 'para que no aparezca "mil millón", sino "mil millones"
caDternA = caDternA & " millón"
Else
caDternA = caDternA & " millones"
End If
Case 2, 4
If teR > 0 Then caDternA = caDternA & " mil"
End Select
resultadO = caDternA & resultadO
i = i - 3
Loop While i > 0 'hasta que se acaben las ternas
NUMALET = "Son:" & UCase(Mid(resultadO, 2, 1)) & Mid(resultadO, 3, Len(resultadO)) & "Bolivares" & "con" & Round((nuM - Int(nuM)), 2) * 100 & "/100.-"
End Function
Public Static Sub llenaConCadenas(matriZ)
matriZ(1, UNI) = " uno"
matriZ(2, UNI) = " dos"
matriZ(3, UNI) = " tres"
matriZ(4, UNI) = " cuatro"
matriZ(5, UNI) = " cinco"
matriZ(6, UNI) = " seis"
matriZ(7, UNI) = " siete"
matriZ(8, UNI) = " ocho"
matriZ(9, UNI) = " nueve"
matriZ(0, DIECI) = " diez"
matriZ(1, DIECI) = " once"
matriZ(2, DIECI) = " doce"
matriZ(3, DIECI) = " trece"
matriZ(4, DIECI) = " catorce"
matriZ(5, DIECI) = " quince"
matriZ(6, DIECI) = " dieciseis"
matriZ(7, DIECI) = " diecisiete"
matriZ(8, DIECI) = " dieciocho"
matriZ(9, DIECI) = " diecinueve"
matriZ(2, DECENA) = " veinti"
matriZ(3, DECENA) = " treinta"
matriZ(4, DECENA) = " cuarenta"
matriZ(5, DECENA) = " cincuenta"
matriZ(6, DECENA) = " sesenta"
matriZ(7, DECENA) = " setenta"
matriZ(8, DECENA) = " ochenta"
matriZ(9, DECENA) = " noventa"
matriZ(5, CENTENA) = " quinientos"
matriZ(7, CENTENA) = " setecientos"
matriZ(9, CENTENA) = " novecientos"
End Sub