Pasar datos de user form a celda en excel con formato porcentual

Estoy trabajando con un User Form que envía datos de facturación a una hoja de excel. Tengo un campo en el User Form que corresponde a descuento, necesito que este se copie en la hoja de excel con formato porcentual.

1 respuesta

Respuesta
2

Sería un código de este tipo

Private Sub CommandButton1_Click()
a = TextBox1 / 100
porcentaje = Format(a, "0,0%")
Range("a1") = porcentaje
End Sub

Donde la variable porcentaje le asigna el formato descrito a la celda que necesites.

Gracias Juan Pedro:

Al hacerlo recibo el mensaje de 'Se a producido el error 13 en tiempo de ejecución: No coinciden los tipos

Supongo habrás creado el userform, ¿con el textbox correspondiente?, te anexo el excel con el ejemplo para ver si lo puedes adaptar.

https://mega.nz/#!4YxnATAB!3GAzMOciT_ry99RNeKfVa7yBtk8Oy72h_2c4IapV6rg

Estimado Juan Pedro:

Este es el User Form que estoy manejando

y este es el código actual de este UF, el rango en el que necesito que se copie el valor de descuento es "J" & FF + 16, claro, este valor deberá copiarse siempre y cuando se ingrese algún valor en el campo de descuento

Private Sub cmdAceptar_Click()
Dim Pos As Double
Dim Codigo As Single
Dim Producto As String
Dim Unidades As Single
Dim PrecioUni As Double     
Dim IVA As Variant
Dim B As Single
Dim UnidadesInventario As Variant
Pos = lstProductos.ListIndex
If Pos < 0 Then
    MsgBox "Por favor selecciona un producto de la lista.", 
      vbInformation, "Seleccionar Productos"
    Exit Sub
End If
Producto = lstProductos.List(Pos, 1)
If txtUnidades = "" Then
    MsgBox "Debes ingresar la cantidad de unidades a facturar del producto " 
     & Producto & ".", vbExclamation, "Ingresar Cantidad"
    Exit Sub
End If
If optPrecioVenta1.Value = False And optPrecioVenta2.Value = False And 
optPrecioVenta3.Value = False And optPrecioVenta4.Value = False Then
    MsgBox "Debes seleccionar alguno de los 4 precios de venta", 
vbExclamation, "Seleccionar Precio de Venta"
    Exit Sub
End If
If optPrecioVenta4.Value = True Then
    If txtPrecio4.Value = "" Then
        MsgBox "Debes ingresar el Precio de Venta 4", 
vbExclamation, "Ingresar precio de venta 4"
        Exit Sub
    Else
        If Not IsNumeric(txtPrecio4) Then
            txtPrecio4 = Empty
            MsgBox "Valor ingresado no es Numérico en Precio 4, 
intente nuevamente.", vbCritical, "Ingresar Precio de Venta 4"
            Exit Sub
        End If
    End If
End If
If Not IsNumeric(txtUnidades) Then
    txtUnidades = Empty
    MsgBox "Valor ingresado no es Numérico, intente nuevamente.", 
vbCritical, "Ingresar Cantidad Unidades"
    'EM: volver al control para que se ingrese este campo
    txtUnidades.SetFocus
    Exit Sub
End If
Unidades = txtUnidades.Value
UnidadesInventario = lstProductos.List(Pos, 3)
If Not IsNumeric(UnidadesInventario) Then
    MsgBox "No se han cargado las unidades disponibles al Inventario", 
vbCritical
    Exit Sub
End If
If Unidades > lstProductos.List(Pos, 3) Then
    MsgBox "La cantidad de unidades disponibles en inventario es 
menor a la solicitada para el producto " & Producto & ".", 
vbCritical, "Cantidad unidades"
    Exit Sub
End If
Application.ScreenUpdating = False
If optPrecioVenta1.Value = True Then PrecioUnitario = CDbl(txtPrecio1) 
If optPrecioVenta2.Value = True Then PrecioUnitario = CDbl(txtPrecio2)
If optPrecioVenta3.Value = True Then PrecioUnitario = CDbl(txtPrecio3)
If optPrecioVenta4.Value = True Then PrecioUnitario = CDbl(txtPrecio4)
Codigo = lstProductos.List(Pos, 0)
IVA = lstProductos.List(Pos, 4)
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Do While ActiveCell <> ""
        If ActiveCell.Value = Codigo Then
            FF = ActiveCell.Row
            Unidades = Unidades + Range("D" & FF).Value
            B = 1
            Exit Do
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    If B = 0 Then FF = ActiveCell.Row
Else
    FF = 4
End If
Range("B" & FF) = Codigo
Range("C" & FF) = Producto
Range("D" & FF) = Unidades
Range("E" & FF) = PrecioUnitario
Range("F" & FF) = Range("E" & FF).Value * Range("D" & FF)
Range("G" & FF) = IVA
Range("H" & FF) = Range("F" & FF).Value * Range("G" & FF)
Hoja10.Visible = xlSheetHidden
ListaProductos
ListaFactura
Hoja12.Select
txtUnidades = ""
txtPrecio1 = ""
txtPrecio2 = ""
txtPrecio3 = ""
txtPrecio4 = ""
txtDcto = "" 'LF AÑADIDO PARA PRUEBA DCTO
Application.ScreenUpdating = True
End Sub
Private Sub cmdCancelar_Click()
Application.ScreenUpdating = False
Hoja12.Select
End
End Sub
Private Sub cmdEliminarProducto_Click()
Dim PosE As Single
Dim CodigoE As Single
Dim ProudctoE As String
Application.ScreenUpdating = False
PosE = lstFactura.ListIndex
If PosE < 0 Then
    MsgBox "Por favor selecciona un producto a eliminar de la Factura.", 
vbInformation, "Seleccionar Productos"
    Exit Sub
End If
CodigoE = lstFactura.List(PosE, 0)
If CodigoE = 0 Then
    MsgBox "Por favor selecciona un producto a eliminar de la Factura.", 
vbInformation, "Seleccionar Productos"
    Exit Sub
End If
ProudctoE = lstFactura.List(PosE, 1)
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Do While ActiveCell.Value <> CodigoE
        ActiveCell.Offset(1, 0).Select
    Loop
    Selection.EntireRow.Delete
    MsgBox "Se eliminó de la factura el producto " & ProudctoE & ".",
 vbInformation, "Producto Eliminado"
Else
    MsgBox "El producto a eliminar no se encuentra en la factura", 
vbCritical, "Producto a Eliminar"
End If
Hoja10.Visible = xlSheetHidden
ListaProductos
ListaFactura
Hoja12.Select
Application.ScreenUpdating = True
End Sub
Private Sub cmdFacturar_Click()
      ' Dim Producto As Single    'EM: declaración duplicada
Dim Codigo As Single
Dim Producto As String
Dim Unidades As Single
Dim PrecioUnit As Double
Dim Subtotal As Double
Application.ScreenUpdating = False
If txtTotal.Value = 0 Then
    MsgBox "No hay productos para generar factura.", vbExclamation, 
"Generar Factura"
    Exit Sub
End If
Fact = MsgBox("Estás seguro de ingresar estos productos a la factura?", 
vbYesNo, "Generar Factura")
If Fact = vbYes Then
    Producto = lstFactura.ListCount - 1
    Hoja10.Visible = xlSheetVisible
    Hoja10.Select
    Range("B3").Select
    ActiveCell.Offset(1, 0).Select
    If ActiveCell.Value <> "" Then
        Range("B3").End(xlDown).Select
        FF = ActiveCell.Row
    Else
        FF = 4
    End If
    Range("B4" & ":G" & FF).Select
    Selection.Copy
    Hoja12.Select
    Range("D28").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("D27").End(xlDown).Select
    FF = ActiveCell.Row
    For I = 28 To FF
        Range("J" & I).FormulaLocal = "=H" & I & "*I" & I
        Range("K" & I).FormulaLocal = "=H" & I & "+J" & I
    Next
    Range("J" & FF + 15 & ":J" & FF + 19 & ",J" & FF + 15 & ":K" & FF + 
19 & ",J" & FF + 15 & ":K" & FF + 19 & ",J" & FF + 15 & ":K" & FF + 19)
.Select
    BordeDerecho
    BordeInferior
    BordeIzquierdo
    BordeSuperior ' LF: PINTA LAS LINEAS DE TOTALES
    BordeInternoHorizontal
    BordeInternoVertical
    Range("D28:K" & FF).Select
    BordeDerecho
    BordeInferior
    BordeIzquierdo
    BordeSuperior
    BordeInternoHorizontal
    BordeInternoVertical
    Range("J" & FF + 19 & ":K" & FF + 19).Select  
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149998474074526
        .Weight = xlThin
    End With
    BordeDerecho
    BordeInferior
    BordeIzquierdo
    BordeSuperior
    BordeInternoHorizontal
    BordeInternoVertical
    Range("D" & FF + 1 & ":K" & FF + 19).Select  
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.149998474074526
        .Weight = xlThin
    End With
    BordeDerecho
    BordeInferior
    BordeIzquierdo
    BordeSuperior  
    Range("J" & FF + 15) = "Subtotal:" '2 solo titulos
    Range("I" & FF + 16) = "Descuento:" '3
    Range("J" & FF + 17) = "Total IVA 5%:" '4
    Range("J" & FF + 18) = "Total IVA 16%:" '5
    Range("J" & FF + 19) = "Total Factura:" '6
    Range("J" & FF + 19 & ":K" & FF + 19).Select '6
    Selection.Font.Bold = True
    Range("K" & FF + 15).FormulaLocal = "=SUMA(H28:H" & FF & ")" 
    Range("K" & FF + 16).FormulaR1C1 = "=+R[-1]C*RC[-1]"
    Range("K" & FF + 17).FormulaR1C1 = "=SUMIFS(R28C[-1]:R[-4]C[-1],R28C
[-2]:R[-4]C[-2],5%)*(1-(R[-1]C[-1]))"
    Range("K" & FF + 18).FormulaR1C1 = "=SUMIFS(R28C[-1]:R[-4]C[-1],R28C
[-2]:R[-4]C[-2],16%)*(1-(R[-2]C[-1]))"
    Range("K" & FF + 19).FormulaLocal = "=K" & FF + 15 & "+K" & FF + 17 
& "+K" & FF + 18 & "-SUMA(K" & FF + 16 & ":K" & FF + 16 & ")"  
Else
    Exit Sub
End If
Hoja12.Select
End
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Range("B3").End(xlDown).Select
    FF = ActiveCell.Row
    Rows("4:" & FF).Select
    Selection.Delete Shift:=xlUp
    Range("B3").Select
Else
    MsgBox "No hay productos en Factura", vbExclamation, 
"Borrar Productos"
    Hoja11.Visible = xlSheetHidden
    Hoja12.Select
    Exit Sub
End If
Hoja10.Visible = xlSheetHidden
ListaProductos
ListaFactura
Hoja12.Select
Application.ScreenUpdating = True
End Sub
Private Sub lstFactura_Click()
End Sub
Private Sub lstProductos_Click()
Dim Codigo As Single
Dim Precio1 As Double
Dim Precio2 As Double
Dim Precio3 As Double
Dim Item As Double
Application.ScreenUpdating = False
Item = lstProductos.ListIndex
If Item < 0 Then
    MsgBox "Por favor selecciona un producto de la lista", 
vbInformation
    Exit Sub
End If
optPrecioVenta1.Enabled = True
optPrecioVenta2.Enabled = True
optPrecioVenta3.Enabled = True
optPrecioVenta4.Enabled = True
optPrecioVenta1.Value = False
optPrecioVenta2.Value = False
optPrecioVenta3.Value = False
optPrecioVenta4.Value = False
txtPrecio4.Value = ""
txtPrecio4.Enabled = False
Item = lstProductos.ListIndex
Codigo = lstProductos.List(Item, 0)
If Codigo = 0 Then Exit Sub
Hoja11.Visible = xlSheetVisible
Hoja11.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Do While ActiveCell <> ""
        If ActiveCell.Value = Codigo Then
            FF = ActiveCell.Row
            Exit Do
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End If
txtPrecio1 = Range("G" & FF).Value  
txtPrecio2 = Range("H" & FF).Value
txtPrecio3 = Range("I" & FF).Value
txtPrecio1 = Format(txtPrecio1, "$###,##0.00")  
txtPrecio2 = Format(txtPrecio2, "$###,##0.00")   
txtPrecio3 = Format(txtPrecio3, "$###,##0.00")  
txtPrecio4 = Format(txtPrecio4, "$###,##0.00")  
If txtPrecio1 = "" Then optPrecioVenta1.Enabled = False
If txtPrecio2 = "" Then optPrecioVenta2.Enabled = False
If txtPrecio3 = "" Then optPrecioVenta3.Enabled = False
Hoja12.Select
End Sub
Private Sub optPrecioVenta1_Click()
txtPrecio4.Enabled = False
txtPrecio4.Value = ""
End Sub
Private Sub optPrecioVenta2_Click()
txtPrecio4.Enabled = False
txtPrecio4.Value = ""
End Sub
Private Sub optPrecioVenta3_Click()
txtPrecio4.Enabled = False
txtPrecio4.Value = ""
End Sub
Private Sub optPrecioVenta4_Click()
txtPrecio4.Enabled = True
txtPrecio4 = Format(txtPrecio4, "$###,##0.00")  
Private Sub TextBox1_Change()
End Sub
Private Sub txtDcto_Change()    'Juan Pedro
a = txtDcto / 100
Porcentaje = Format(a, "0,0%")
Range("J" & FF + 16) = Porcentaje
End Sub
Private Sub txtPrecio1_Change()
End Sub
Private Sub txtPrecio2_Change()
End Sub
Private Sub txtPrecio3_Change()
End Sub
Private Sub txtPrecio4_AfterUpdate()
txtPrecio4 = Format(txtPrecio4, "$###,##0.00")  
End Sub
Private Sub txtUnidades_Change()
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Hoja12.Select
Range("D27").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Range("D27").End(xlDown).Select
    FF = ActiveCell.Row + 30
    Rows("28:" & FF).Select
    Selection.Delete Shift:=xlUp
    Range("D27").Select
End If
ListaProductos
ListaFactura
Hoja12.Select
txtPrecio4.Enabled = False
optPrecioVenta1.Enabled = False
optPrecioVenta2.Enabled = False
optPrecioVenta3.Enabled = False
optPrecioVenta4.Enabled = False
Application.ScreenUpdating = True
End Sub
Public Sub ListaProductos()
Application.ScreenUpdating = False
lstProductos.ColumnCount = 5
lstProductos.ColumnHeads = True
Hoja11.Visible = xlSheetVisible
Hoja11.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
    Wend
    FF = ActiveCell.Row - 1
Else
    FF = 4
End If
Range("B4:I" & FF).Select
Selection.ClearContents
Hoja6.Visible = xlSheetVisible
Hoja6.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    Range("B3").End(xlDown).Select
    FF = ActiveCell.Row
Else
    FF = 4
End If
Range("B4:I" & FF).Select
Selection.Copy
Hoja11.Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues
lstProductos.RowSource = "B4:F" & FF
Application.CutCopyMode = False
Hoja11.Visible = xlSheetHidden
Hoja12.Select
Application.ScreenUpdating = True
End Sub
Public Sub ListaFactura()
lstFactura.ColumnCount = 5
lstFactura.ColumnHeads = True
Application.ScreenUpdating = False
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Range("B3").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
    While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
    Wend
    FF = ActiveCell.Row - 1
    lstFactura.RowSource = "B4:F" & FF
End If
Range("F1").FormulaLocal = "=SUMA(F4:F" & FF & ")"
txtTotal = Range("F1").Value
txtTotal = Format(txtTotal, "$###,##0.00")  
Hoja10.Visible = xlSheetHidden
Hoja12.Select
Application.ScreenUpdating = True
End Sub
Public Sub BordeIzquierdo()
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub
Public Sub BordeSuperior()
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub
Public Sub BordeInferior()
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub
Public Sub BordeDerecho()
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub
Public Sub BordeInternoVertical()
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub
Public Sub BordeInternoHorizontal()
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ThemeColor = 1
    .TintAndShade = -0.349986266670736
    .Weight = xlThin
End With
End Sub

Es un gran trabajo y yo no soy maestro en excel, solo un aprendiz un poco aventajado, por tanto mi ayuda no te va a servir, de todas formas para poder probar como hacerlo trabajar, comprenderás que no se puede crear todo ese código y userforms, lo conveniente sería que enviases el fichero, eliminando cualquier base de datos que tenga relación con tu trabajo e intentaría ponerlo en funcionamiento.

Si algún experto tiene la amabilidad de responderte y que no le haga falta el fichero, que comente las modificaciones necesarias.

Siento no poder hacer más.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Pasar de hoja resumen a plantilla de factura

Tengo un Excel, con un hoja resumen de datos, y lo que quisiera hacer, es que me pasara los datos que tengo en cada línea de la hoja resumen de forma de forma automática, a diferentes hojas de excel del mismo libro, en unas celdas concretas,...
2 respuestas

Buscar la ultima fecha de mantenimiento

Tengo una tabla de excel hoja2 que cuando escribo el numero de activo del equipo en la columna A me busca los datos como el nombre del equipo, marca, serie y modelo. Estos datos provienen de la hoja 1. Lo que quiero hacer es que al digital el activo...
2 respuestas

Promedio de las ultimas 100 celdas con numeros

Tengo en la columna 0Y2:OY146 (celdas en blanco y celdas con numeros necesito calcular el promedio de los ultimos 100 numeros de la columna, si la cantidad fuera inferior a 100 que calcule el promedio de la totalidad de las celdas que contenga numeros.
2 respuestas

Abrir formulario desde cuadro combinado

Tengo un cuadro combinado que su nombre es cboForms al que le puesto una lista de varios formularios, el nombre de cada formulario es F_Papeleta_de_sitio_2022, F_Papeleta_del_sitio_2023, F_Papeleta_de_sitio_2024, etc me gustaría que al desplegar el...
3 respuestas

Tengo una base de datos en access para cobrar cuotas

En la cual genere formulario que muestra un resumen de las cuotas pagadas ¿Cómo puedo enviar cada formulario por mail?
2 respuestas

Es estrictamente necesario que una aplicación para android e ios se vea diferente

Si una empresa lanza su aplicación en las tiendas para Android y App Store ¿Esta tendría que verse diferente? Ya que he visto aplicaciones de empresas famosas que se ven un poco mejor diseñadas en Iphone ¿Es estrictamente necesario ofrecer una...
2 respuestas

¿Cómo puedo imprimir informe y actualizar tabla usando un "botón de comando"?

Quiero saber como hacer para que en una tabla, dónde el valor predeterminado es "N" al hacer clic en el botón de comando, imprima 1 informe y actualice a "S" el valor de la tabla pero si en cambio, ese campo esta con valor "S" no imprima ni actualice...
2 respuestas

Tengo una duda access 2010 Reporte vba

Tengo la siguiente sintaxis para filtrar un reporte pero no se filtra no se que tenga mal. DoCmd.OpenReport "ALLM2CONTEDOR", acViewPreview, "FECHA = #" & Format(Me.FECHAOK, "mm-dd-yyyy") & " # AND CONTENEDOR= " & Me.NUMEROCONTENEDOR.Column(1) & ""...
2 respuestas

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
4 respuestas

How much does it cost to hire a professional app developer Dubai

Hello! If you have finally decided to have an app for your business, you need to look for a TOP MOBILE APP DEVELOPMENT AGENCY DUBAI. It doesn't matter if you are creating an app from scratch or re-launching the pre-existing one. You need to hire a...
11 respuestas