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

Error en código para columna de una consulta

Un gusto saludarlos. Quería solicitar su ayuda, porque necesito crear una columna calculada dentro de una consulta access y para eso uso el siguiente código. Saldofinal: IIf(([Nivel]=1 Or [Nivel]=5), ([Sumadesaldoinicial]+[Sumadebe]-[Sumahaber]),...
2 respuestas

Optimizar macro para combinar filas

Tengo una macro que acumula valores de filas determinados según columnas similares, funciona bien con una tabla de datos intermedia en cuanto a su tiempo de ejecución, lo que quiero es optimizar esta macro o mejorarla ya que tengo tablas de hasta...
3 respuestas

Como hacer una consulta de access que me arroje suma por niveles de cuenta.

Un gusto saludarlos. Les comento, estoy haciendo un pequeño programa contable para un pequeño negocio que abrí, el asunto es que no se como crear una consulta, que me permita visualizar. 1. La suma por niveles (nivel 1 primer dígito del campo...
3 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...
12 respuestas

Liberalizar la memoria después de realizar cálculos

En un formulario ejecuto diferentes instrucciones para cálculos de unos totales que he de traspasar a otro formulario a través de un botón. Estoy teniendo el problema que al finalizar el proceso del calculo, me desaparece la pantalla y no puedo...
3 respuestas

Agregar campos de texto en un formulario en ejecución.

Un gusto saludarlos. Tengo un formulario llamado estudiante que viene de una tabla llamada estudiante. Cada estudiante ve un número diferente de asignaturas y asignaturas diferentes. El formulario arranca con los siguientes Campos número de cédula...
2 respuestas

No me funciona el conector AND en el código visual de acces

Un gusto saludarlos. Quisiera saber cómo puedo hacer para que me funcione el conector AND en el código visual de una base de datos hecha en access. Resulta que empecé a hacer un proyecto, pero cuando dentro de un ciclo if, utilizo la palabra AND el...
3 respuestas

Ordenar listado en excel por numero de tienda

Tengo un listado de productos en excel y en la misma celda viene el numero de la tienda y los totales de cada tienda, pero si tengo más de 100 tiendas quiero agregar una columna donde me diga que tienda es y así poder ordenar mi listado por el número...
1 respuesta

Hacer un nuevo archivo copiando la hoja2 y hoja3 de una lista de nombres que están en la hoja1.

En la hoja1 tengo una lista de nombres y quiero copiar la hoja=evaluación y hoja=metas a un nuevo libro con el nombre de la lista de la hoja1 las dos hojas en el mismo nuevo libro.
1 respuesta

Tengo una macro , que necesita que de una lista de alumnos

Imprime un informe de un alumno en particular, necesito que el usuario digite un numero y luego siga con los pasos siguientes, es decir que imprima el usuario seleccionado . ¿Cómo puedo pausar una macro?
2 respuestas