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

¿Cómo separo dos números que se encuentran en una sola celda de excel?

En una celda de excel se encuentran dos cantidades separadas por un guion. Quisiera separar el primer número en una segunda celda y el segundo número en una tercer celda. Ejemplo: A 1 48,264 - 65,371 2 55,555 - 66,666 3 . . . Debería quedar así: A B...
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

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...
8 respuestas

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas