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

Respuesta
2

No mencionás en qué celda de la hoja DATOS está la moneda... imaginaré que es A1. Ajusta en la instrucción siguiente:

NUMALET = "Son: " & UCase(Mid(resultadO, 2, 1)) & Mid(resultadO, 3, Len(resultadO)) & " " & Sheets("DATOS").[A1] & " con " & Round((nuM - Int(nuM)), 2) * 100 & "/100.-"

Le agregué algunos espacios porque tu texto se veía bastante apretado:

1 respuesta más de otro experto

Respuesta
1

[Hola

Prueba así, guardando la configuración de tu formulario a una celda.


Por ejemplo para tu formulario los option

if option1 = true then  sheets("Hoja1").Range("A1") = "Bolivares"

if option2 = true then  sheets("Hoja1").Range("A1") = "Sol"

.

.

.


Y en el módulo de la función numLet actualiza con esto.

NUMALET = "Son:" & UCase(Mid(resultadO, 2, 1)) & Mid(resultadO, 3, Len(resultadO)) & Sheets("Hoja1").Range("A1") & "con" & Round((nuM - Int(nuM)), 2) * 100 & "/100.-"

'

Valora la respuesta mano para arriba para finalizar saludos!

¡Gracias! amigo Adriel muy acertada tu respuesta y el código para cambiar el tipo de moneda y dar valor a la celda en la hoja datos lo desarrolle de esta manera:

Dim Hoja As Worksheet
If OptionButton1.Value = True Then
Application.ScreenUpdating = False
For Each Hoja In Worksheets
Sheets(Hoja.Name).Activate
ActiveSheet.Unprotect "123"
Sheets(Hoja.Name).Range("H17:I31,I33:I40").Select
ActiveSheet.Unprotect "123"
Selection.NumberFormat = "[$$-en-US] * #,##0.00;;;@"
Sheets("DATOS").Range("L3") = "Dolares"
Call QUITARSELC
Next
End If
Sheets("SIFAP").Select
ActiveSheet.Protect "123"

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas