La macro no retoma en forma normal las cifras en pesos, no toma en cuenta el punto decimal.
Para Dante…
Tengo esta macro para recuperar o visualizar información en un USERFORM1. Los pasos se realizan normalmente, solo que los resultados con operaciones aritméticas no se reflejan cómo se esperan (No toma en cuenta el punto decimal; pesos), solicito tu apoyo y te remito la macro… Muchas Gracias por tus atenciones.
Private Sub CommandButton1_Click() 'BUSCAR IDENTIFICACION CMBX VERIFICAR
Application.ScreenUpdating = False
For Each h In Sheets
n = h.Name
If UCase(h.Name) = UCase(ComboBox1) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "la hoja seleccionada no existe", vbCritical, "SELECIONAR HOJA"
Exit Sub
ComboBox1.SetFocus
End If
'encuentra la hoja seleccionada en el cbbx1, identifica datos generales a los txbx
Set h1 = Sheets(ComboBox1.Value)
TextBox1 = h1.Range("D3") 'OBRA arko
TextBox2 = h1.Range("C9") 'OBRA ISi
TextBox3 = h1.Range("D5") 'MPIO
TextBox4 = h1.Range("F5") 'Localidad
TextBox5 = h1.Range("C17")
TextBox6 = h1.Range("D4") 'no. De contrato
ActiveCell.FormulaR1C1 = "=SUM(R[19]C:R[999]C)" ‘Debe sumar Rango(L20:L100)
Range("J1").Select
‘---------------------------------
TextBox7 = h1.Range("J1") 'IMP ACUMULADO DE EST.
With TextBox7
'.Value = Format(.Value, " #,#0")
.Value = Format(.Value, "$ #,##0;[Rojo]-$ #,##0.00")
End With
Application.ScreenUpdating = True
'--------------------------------
TextBox14. SetFocus
End Sub
1 Respuesta
H o l a:
Envíame tu archivo para revisarlo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Francisco Moreno” y el título de esta pregunta.
Hola Dante...
Te envié el Archivo....
Mil Gracias...
H o l a:
Te anexo la macro del botón "Ingresar" para la primera estimación:
Private Sub CommandButton3_Click() 'PARA INSERTAR DATOS DE LAS ESTIMACIONES
'Act. Por. Dante Amor
'Sheets("Obra"). Unprotect "abc"
'Application.ScreenUpdating = False
For Each h In Sheets
n = h.Name
If UCase(h.Name) = UCase(ComboBox1) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "la hoja seleccionada no existe", vbCritical, "SELECIONAR HOJA"
Exit Sub
ComboBox1.SetFocus
End If
'------------------
Set h1 = Sheets(ComboBox1.Value) 'NUEVA FORMULA
Set b = h1.Columns("C").Find(what:=TextBox14, lookat:=xlWhole)
If b Is Nothing Then
MsgBox "El dato no fue encontrado", vbOKOnly + vbInformation, "Aviso"
TextBox14.SetFocus
Exit Sub
End If
'-------------
Select Case Label17
Case "1"
h1.Cells(18, "K") = "ESTIMACION, 1"
h1.Cells(19, "K") = "CANT"
h1.Cells(19, "L") = "IMPORTE"
Set b = h1.Columns("c").Find(TextBox14, lookat:=xlWhole)
If Not b Is Nothing Then
If TextBox15 = "" Then t15 = 0 Else t15 = CDbl(TextBox15.Value)
If TextBox16 = "" Then t16 = 0 Else t16 = CDbl(TextBox16.Value)
If TextBox17 = "" Then t17 = 0 Else t17 = CDbl(TextBox17.Value)
h1.Cells(b.Row, "K") = t16
h1.Cells(b.Row, "L") = t17
TextBox18 = t15 + t17
TextBox18 = Format(TextBox18, "#.00")
End If
Case "2"
h1.Cells(18, 13) = "ESTIMACION, 2"
h1.Cells(19, 13) = "CANT"
h1.Cells(19, 14) = "IMPORTE"
Set b = h1.Columns("c").Find(TextBox14, lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(b.Row, "M") = Val(TextBox16)
h1.Cells(b.Row, "N") = Val(TextBox17)
TextBox18 = TextBox15 + TextBox17
'SUMAR(N22:N1000)
End If
Case "3"
h1.Cells(18, 15) = "ESTIMACION, 3"
h1.Cells(19, 15) = "CANT"
h1.Cells(19, 16) = "IMPORTE"
If Not b Is Nothing Then
h1.Cells(b.Row, "O") = Val(TextBox16)
h1.Cells(b.Row, "P") = Val(TextBox17)
'SUMAR(P22:P1000)
End If
End Select
'-----------------
If TextBox10 = "" Then t10 = 0 Else t10 = CDbl(TextBox10)
If TextBox16 = "" Then t16 = 0 Else t16 = CDbl(TextBox16)
TextBox17 = t16 * t10
TextBox17 = Format(TextBox17, "#.00")
'Se suma los importes de todas las estimaciones y se refleja en TxBx13
TextBox15 = h1.Range("L" & b.Row) + h1.Range("N" & b.Row) + h1.Range("P" & b.Row) + h1.Range("R" & b.Row) + h1.Range("T" & b.Row) + h1.Range("v" & b.Row) + h1.Range("x" & b.Row) + h1.Range("Z" & b.Row) + h1.Range("AB" & b.Row) + h1.Range("AD" & b.Row) + h1.Range("AF" & b.Row) + h1.Range("AH" & b.Row) + h1.Range("AJ" & b.Row) + h1.Range("AL" & b.Row) + h1.Range("AN" & b.Row) + h1.Range("AP" & b.Row) + h1.Range("AR" & b.Row) + h1.Range("AT" & b.Row) + h1.Range("AV" & b.Row) + h1.Range("AX" & b.Row) + h1.Range("AZ" & b.Row) + h1.Range("BB" & b.Row) + h1.Range("BD" & b.Row) + h1.Range("BF" & b.Row) + h1.Range("BH" & b.Row) + h1.Range("BJ" & b.Row) + h1.Range("BL" & b.Row) + h1.Range("BN" & b.Row) + h1.Range("BP" & b.Row) + h1.Range("BR" & b.Row)
TextBox15 = Format(TextBox15, "#.00")
'Y Esta suma-resultado se escribe en la celda J
If TextBox15 = "" Then t15 = 0 Else t15 = CDbl(TextBox15)
h1.Range("J" & b.Row) = t15
'Y Esta suma-resultado se escribe en la celda I
TextBox13 = h1.Range("K" & b.Row) + h1.Range("M" & b.Row) + h1.Range("O" & b.Row) + h1.Range("Q" & b.Row) + h1.Range("S" & b.Row) + h1.Range("U" & b.Row) + h1.Range("W" & b.Row) + h1.Range("Y" & b.Row) + h1.Range("AA" & b.Row) + h1.Range("AC" & b.Row) + h1.Range("AE" & b.Row) + h1.Range("AG" & b.Row) + h1.Range("AI" & b.Row) + h1.Range("AK" & b.Row) + h1.Range("AM" & b.Row) + h1.Range("AO" & b.Row) + h1.Range("AQ" & b.Row) + h1.Range("AS" & b.Row) + h1.Range("AU" & b.Row) + h1.Range("AW" & b.Row) + h1.Range("AY" & b.Row) + h1.Range("BA" & b.Row) + h1.Range("BC" & b.Row) + h1.Range("BE" & b.Row) + h1.Range("BG" & b.Row) + h1.Range("BI" & b.Row) + h1.Range("BK" & b.Row) + h1.Range("BM" & b.Row) + h1.Range("BO" & b.Row) + h1.Range("BQ" & b.Row)
TextBox13 = Format(TextBox13, "#.00")
If TextBox13 = "" Then t13 = 0 Else t13 = CDbl(TextBox13)
h1.Range("I" & b.Row) = t13
'FALTA CODIGO PARA SUME LA COLUMNA J DE SUMA DE LA ESTIMACION EN COMENTO
'Sheets("Obra").Protect "abc"
'¿TextBox16.SetFocus
'TextBox14 = ""
TextBox14.SetFocus
End SubRevisa cómo resolví la primera estimación para que lo repliques en las estimaciones 2 y 3.
También ajusté el código en el botón "Buscar":
Private Sub CommandButton2_Click() 'BUSCAR IDENTIFICACION CONCEPTO ALFANUMERICO
'DE OBRA
'Application.ScreenUpdating = False
For Each h In Sheets
n = h.Name
If UCase(h.Name) = UCase(ComboBox1) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "La hoja seleccionada no existe", vbCritical, "SELECCIONAR OBRA"
ComboBox1.SetFocus
Exit Sub
End If
'--------------------
Set h1 = Sheets(ComboBox1.Value)
Label17 = h1.Range("C18")
Set b = h1.Columns("C").Find(what:=TextBox14, lookat:=xlWhole) ', LookIn:=xlValues) ¿ESTA FUNCIONA CON TextBox
If Not b Is Nothing Then
TextBox8 = h1.Range("D" & b.Row)
TextBox9 = h1.Range("E" & b.Row)
TextBox10 = h1.Range("G" & b.Row)
TextBox11 = Format(h1.Range("F" & b.Row).Value, "#.00")
TextBox12 = Format(h1.Range("H" & b.Row).Value, "#.00")
TextBox13 = Format(h1.Range("I" & b.Row).Value, "#.00")
TextBox15 = Format(h1.Range("J" & b.Row).Value, "#.00")
'------------
If TextBox19 = 0 Or TextBox19 = "" Then 'correcto
MsgBox "El Concepto no presenta estimación," & Chr(13) & "Deseas capturar la primara estimación...? .", vbOKOnly + vbInformation + vbYesNo '"Aviso"
'si la respuesta es si, then
Range("b" & Cells.Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.Offset(16, 1) = "1"
Else
ActiveCell.Offset(16, 1) = " "
Exit Sub
End If
'------------
TextBox16.SetFocus 'ok
'------------
Else
MsgBox "El Dato no fue encontrado." & Chr(13) & "Intente de nuevo.", vbOKOnly + vbInformation, "Aviso"
TextBox14 = "" 'ok
TextBox14.SetFocus 'ok
End If
'----------------------------------
h1.Cells(18, 11) = "ESTIMACION, 1"
h1.Cells(19, 11) = "CANT"
h1.Cells(19, 12) = "IMPORTE"
Application.ScreenUpdating = True
TextBox16 = ""
TextBox17 = ""
End Sub ' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Hola Dante… He probado la corrección de esta macro, todo hace perfectamente, las sumatorias de varias celdas, la colocación de la información el los TxBox, pero tiene el siguiente detalle. Cuando introduzco una cantidad (incluso el no. 1) en el TxBx16 para que lo multiplique por el TxBx 10, que es el precio (en pesos y centavos) el resultado que me refiere es como si ese “1” lo multiplicara por “100”, es decir, al resultado normal por esta multiplicación le salen 2 ceros más. Ejem.
50.25 x 1 = 5025.00
50.25 x 100= 502500.00
Mi pregunta: Le faltará alguna propiedad especial al Txbx16..?
Agradezco tus atenciones…
H o l a:
Ya hice la siguiente prueba, hoja: Obra5, Folio: CM11121, cantidad: 1. Presiono el botón "INGRESAR", el cálculo en el Textbox17 es igual a 50.25
¿En qué momento tienes el problema?
Hola Dam… Muchas gracias… fíjate que a mí no me resulta la operación que tú hiciste… pero si tienes un tiempecito vuelve hacer el mismo ejemplo y luego trata de hacer otra captura con otra cantidad. El 50.25 que te resulta a ti debe asentarse en la celda L25 que es la que le corresponde. Y el siguiente código que insertes deberá hacer lo mismo y el resultado asentarse en la celda que le corresponda. Pero el resultado a mí me sigue saliendo con dos cifras de más antes del punto decimal. Muchas Gracias de nuevo...
Ya lo repetí y me sale correcto el resultado, debuggea el programa para que analices variable por variable qué valor contiene y en qué momento te está haciendo el problema.
Son varios detalles que corregí en tu macro, los primeros detalles era corregir la presentación en los textbox.
Si quieres sigo revisando los resultados que se pasan a las celdas. Recuerda valorar esta respuesta y crea una nueva para verificar los siguientes detalles.
Sal u dos
Si... Efectivamente dam ya me resultó, creo que moví algo... yo le sigo... Muchas¡Gracias! luego volveré a solicitarte...muchas gracias...
