Problema de ejemplo de faturacion
Que tal mauricio, tengo desde hace tiempo un ejemplo de facturación que baje contigo
pero ya le he dado un sin fin de vueltas y no puedo volcar los datos a la hoja de impresión
Solo he podido volcar los datos del
txttotal
cboclientes
Pero en frangodetalles
Y frango productos no he podido
Para que me aparezcan en la factura empezando por la celda "c7"
Me podrías orientar gracias
pero ya le he dado un sin fin de vueltas y no puedo volcar los datos a la hoja de impresión
Solo he podido volcar los datos del
txttotal
cboclientes
Pero en frangodetalles
Y frango productos no he podido
Para que me aparezcan en la factura empezando por la celda "c7"
Me podrías orientar gracias
Respuesta de valedor
1
No se a que te refieres con "frangodetalles" y "frangoproductos", si me das detalles más claros, con gusto te ayudo.
Hola mauricio, mira baje del discovirtual un proyecto no terminado, de facturación pero no vuelca los datos del userform(factura) a la hoja impresión, solo a la de detalle, preoductos y facturación, mi problema es que quiero mandarlos a la hoja impresión, pero ya le di mil y una vuelta al asunto y ya casi logro que vuelque lo que ocupo, no se me doy a entender, y lo de frangodetalles y f rango productos es de donde toma los valores para ponerlos en la hoja de impresión, así que te vuelvo a molestar más tarde, pero te mando el código para no quedarnos en blanco
y sepas de lo que te hablo
este código del frm(factura)
Option Explicit
DefInt A-Z
Option Base 1
Private Type Detalle
Cantidad As Single
Precio As Single
Posicion As Integer
End Type
Dim impresion() As Detalle ' lo agrege pensando que la variable seria util
Dim Factura() As Detalle
Dim fRangoFacturas As range
Dim fRangoClientes As range
Dim fRangoProductos As range
Dim fRangoDetalles As range
Dim frangoimpresion As range
Dim datFecha As Date
Dim intNumProductos As Integer
Dim Subtotal As Single
Dim Impuesto As Single
Dim Total As Single
Private Sub Calendario_DblClick()
Dim intRes As Integer
If datFecha > Calendario.Value Then
intRes = MsgBox("La fecha seleccionada es anterior" & vbCrLf & vbCrLf & _
"¿Deseas continuar", vbYesNo + vbQuestion, "Fecha anterior")
If intRes = vbYes Then
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = True
End If
Else
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = True
End If
End Sub
Private Sub Calendario_Exit(ByVal Cancel As MSForms.ReturnBoolean)
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = False
End Sub
Private Sub cboClientes_Change()
'Workbooks("glibrocatalogo").Worksheets("impresion").Activate
'Sheets(Array("impresion")).Select
'Range("C2").Value = cboClientes.Value
End Sub
'Private Sub cboClientes_Click()
'Sheets(Array("impresion")).Activate
'Range("C2").Value = cboClientes.Value
'End Sub
Private Sub cmdAgregar_Click()
Dim Cantidad As String
Dim co1 As Integer
If lstProductos.listindex > -1 Then
If Val(lblExistencia.Caption) > 0 Then
Cantidad = InputBox("Introduce la cantidad", "Cantidad", "1")
If Cantidad <> "" And IsNumeric(Cantidad) Then
If Abs(Val(Cantidad)) <= Val(Trim(lblExistencia.Caption)) Then
If Not Existe(lstProductos.listindex + 2) Then
AgregaProducto (Abs(Val(Cantidad)))
Else
MsgBox "El producto ya esta en la factura", vbInformation
End If
Else
MsgBox "La cantidad debe ser menor o igual a la existencia", vbCritical, "No valido"
End If
Else
MsgBox "La cantidad debe ser un número", vbInformation, "No valido"
End If
Else
MsgBox "No hay producto en existencia", vbInformation, "Sin existencia"
End If
Else
MsgBox "No hay producto seleccionado"
End If
End Sub
Private Sub cmdCalculadora_Click()
Dim RetornarValor 'As Double
Dim Ejecutando 'As Long
On Error GoTo ControlError
'Busca si ya esta en ejecución la calculadora
Ejecutando = FindWindow(vbNullString, "Calculadora")
If Ejecutando = 0 Then
RetornarValor = Shell("C:\WINDOWS\CALC.EXE") ' Ejecuta la Calculadora.
AppActivate RetornarValor, False
Else
AppActivate "Calculadora", False 'Solo la activa
End If
Exit Sub
ControlError:
Err.Clear
End Sub
Private Sub cmdFactura_Click()
Dim NuevaFila As Integer
Dim co1 As Integer
Dim co2 As Integer
Dim range As range
Dim frangodetalle As sheImpresion
Dim cell As Boolean
If cboClientes.listindex > -1 Then
If lstDetalle.ListCount > 0 Then
With fRangoFacturas
NuevaFila = .Rows.Count + 1
.Cells(NuevaFila, 1).Value = Val(txtFactura.Text)
.Cells(NuevaFila, 2).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 2).Value 'DA EL NOMBRE EN LA HOJA DE FACTURA EL 2
.Cells(NuevaFila, 3).Value = txtFecha.Text
.Cells(NuevaFila, 4).Value = Round(Subtotal, 2)
.Cells(NuevaFila, 5).Value = Round(Impuesto * 100, 2)
.Cells(NuevaFila, 6).Value = Round(Total, 2)
.Cells(NuevaFila, 7).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 1).Value ' TIENE QUE DAR LA CLAVE DE CLIENTE DES PUES DEL P.U.
.Cells(NuevaFila, 8).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 3).Value
End With
txtFactura.Text = Str(Val(txtFactura.Text) + 1)
Set fRangoFacturas = Workbooks(gLibroCatalogo).Worksheets("Facturacion").Cells(1, 1).CurrentRegion
With fRangoDetalles
For co1 = 1 To UBound(Factura) ' a qui empieza a llenar la hoja de DETALLE
.Cells(.Rows.Count + co1, 1).Value = Val(txtFactura.Text) ' esto pone el valor del numero de la factura
.Cells(.Rows.Count + co1, 2).Value = fRangoProductos.Cells(Factura(co1).Posicion, 1) ' aqui se pasa el valor de los productos
.Cells(.Rows.Count + co1, 3).Value = fRangoProductos.Cells(Factura(co1).Posicion, 2)
.Cells(.Rows.Count + co1, 4).Value = fRangoProductos.Cells(Factura(co1).Posicion, 3)
.Cells(.Rows.Count + co1, 8).Value = fRangoClientes.Cells(cboClientes.listindex + 2, 2).Value ' este es el nobre del cliente
.Cells(.Rows.Count + co1, 5).Value = Factura(co1).Cantidad
.Cells(.Rows.Count + co1, 6).Value = Factura(co1).Precio
Next co1
End With
Set fRangoDetalles = Workbooks(gLibroCatalogo).Worksheets("Detalle").Cells(1, 1).CurrentRegion
cboClientes.listindex = -1
'lstDetalle.Clear
' AQUI EMPIEZAN MIS PROBLEMAS
'aquí debieras agregar esto
With frangoimpresion
For co1 = 1 To UBound(Factura) ' a qui empieza a llenar la hoja de DETALLE
'.Cells(.Rows.Count + co1, 1).Value = Val(txtFactura.Text) ' esto pone el valor del numero de la factura
.Cells(.Rows.Count + co1, 7).Value = fRangoProductos.Cells(Factura(co1).Posicion, 4) ' aqui se pasa el valor de los productos
.Cells(.Rows.Count + co1, 3).Value = fRangoProductos.Cells(Factura(co1).Posicion, 2)
.Cells(.Rows.Count + co1, 2).Value = Factura(co1).Cantidad
.range("c2").Value = cboClientes.Value
.range("B4").Value = txtFecha.Value
.range("h20").Value = txtSubtotal.Value
.range("h22").Value = txtTotal.Value
'.cells("C2").Value = fRangoClientes.Cells(cboClientes.listindex + 2, 2).Value ' este es el nobre del cliente
'.Cells(.Rows.Count + co1, 5).Value = Factura(co1).Cantidad
'.Cells(.Rows.Count + co1, 7).Value = Factura(co1).Precio
Next co1
End With
Set frangoimpresion = Workbooks(gLibroCatalogo).Worksheets("impresion").Cells(1, 1).CurrentRegion
cboClientes.listindex = -1
'NuevaFila = .Rows.Count + 1
'.Cells(NuevaFila, 2).Value = txtFecha.Text
'.Cells(NuevaFila, 6).Value = Round(Total, 5)
'.Cells(NuevaFila, 4).Value = Round(Subtotal, 2)
'For co1 = 1 To UBound(impresion)
'.Cells(.Rows.Count + co1, 8).Value = frangoimpresion.Cells(impresion(co1).Posicion, 1)
'.Cells(.Rows.Count + co1, 9).Value = frangoimpresion(col).Precio
'range("c2").Value = cboClientes.Value
'range("B4").Value = txtFecha.Value
'range("h20").Value = txtSubtotal.Value
'range("h22").Value = txtTotal.Value
'range("D7").Value = frangodetalle.Value
'Set frangoimpresion = Workbooks(gLibroCatalogo).Worksheets("impresion").Cells(1, 1).CurrentRegion
'Next co1
'End With
'Else
'Erase Factura
MsgBox " los datos son correctos"
MsgBox "Factura registrada correctamente"
lstProductos.SetFocus
Else
MsgBox "No se han agregado productos"
End If
Else
MsgBox "Debes escoger un cliente"
End If
End Sub
Private Sub cmdFactura_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
End Sub
Private Sub cmdQuitar_Click()
Dim Cantidad As Single
Dim Res As Integer
Dim co1 As Integer
Dim PosPrecio As Integer
Dim NumPrecio As Integer
If lstDetalle.ListCount > 0 Then
NumPrecio = lstDetalle.listindex + 1
PosPrecio = Factura(NumPrecio).Posicion
Cantidad = Factura(NumPrecio).Cantidad
Res = MsgBox("Estas seguro de quitar este precio", vbYesNo, "Quitar")
If Res = vbYes Then
With fRangoProductos
.Cells(PosPrecio, 5).Value = .Cells(PosPrecio, 5).Value + Cantidad
End With
lstDetalle.RemoveItem lstDetalle.listindex
Subtotal = Subtotal - (Cantidad * Factura(NumPrecio).Precio)
txtSubtotal.Text = Format(Subtotal, "$ #,##0.00")
Impuesto = Round(Val(txtImpuesto.Text) / 100, 2)
Total = Subtotal * (Impuesto + 1)
txtTotal.Text = Format(Total, "$ #,##0.00")
If NumPrecio < UBound(Factura) Then
For co1 = NumPrecio To UBound(Factura) - 1
Factura(co1) = Factura(co1 + 1)
Next co1
End If
If lstDetalle.ListCount > 0 Then
ReDim Preserve Factura(UBound(Factura) - 1)
Else
Erase Factura
End If
With lstProductos
.SetFocus
.listindex = PosPrecio - 2
End With
lstProductos_Click
End If
End If
End Sub
Private Sub cmdQuitarTodos_Click()
Dim Res As Integer
Dim co1 As Integer
If cmdQuitarTodos.Tag = "" Then
If lstDetalle.ListCount > 0 Then
Res = MsgBox("Estas seguro de quitar todos los precios", vbYesNo, "Vaciar")
Else
Res = 7
End If
End If
If Res = 0 Or Res = vbYes Then
For co1 = 1 To UBound(Factura)
fRangoProductos.Cells(Factura(co1).Posicion, 5).Value = _
fRangoProductos.Cells(Factura(co1).Posicion, 5).Value + _
Factura(co1).Cantidad
Next co1
lstDetalle.Clear
Erase Factura
Subtotal = 0
Total = 0
txtSubtotal.Text = ""
txtTotal.Text = ""
MsgBox "Se han quitado todos los precios"
End If
End Sub
Private Sub imgFecha_Click()
If Calendario.Visible Then
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
Calendario.Visible = False
imgFecha.SpecialEffect = fmSpecialEffectRaised
Else
datFecha = CDate(txtFecha.Text)
imgFecha.SpecialEffect = fmSpecialEffectSunken
Calendario.Visible = True
Calendario.ZOrder
Calendario.SetFocus
End If
End Sub
Private Sub imprimir_Click()
Dim Celdainicial As Variant
Dim co1 As Integer
Dim col As Integer
Dim fila As Integer
'Dim txtfechas As Date
Worksheets("impresion").Select
'Dim cboClientes As Single
'Dim range As Integer
Celdainicial = "b4" ' aqui va moviendo la celda para pegar la fecha
Set Celdainicial = range(Celdainicial)
col = Celdainicial.Column
'bbusca cual es la ultima fila
fila = Celdainicial.End(xlDown).Row - 0
' comienza a copiar los valores
Cells(fila, col).Value = txtFecha.Value
range("c2").Value = cboClientes.Value
range("h20").Value = txtTotal.Value
Set Celdainicial = Nothing
End Sub
Private Sub lblClave_Click()
End Sub
Private Sub lblExistencia_Click()
End Sub
Private Sub lblFecha_Click()
End Sub
Private Sub lblInfo1_Click()
End Sub
Private Sub lblInfo5_Click()
End Sub
Private Sub lblPrecioU_Click()
End Sub
Private Sub lstDetalle_Click()
lblInfo4.Caption = "Cantidad"
lblClave.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 1).Value
lblUnidad.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 3).Value
lblPrecioU.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 4).Value
lblExistencia.Caption = " " & Factura(lstDetalle.listindex + 1).Cantidad
End Sub
Private Sub lstDetalle_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdQuitar_Click
End Sub
Private Sub lstDetalle_Enter()
If lstDetalle.ListCount > 0 Then
lblInfo4.Caption = "Cantidad"
End If
End Sub
Private Sub lstProductos_Click()
lblInfo4.Caption = "Existencia"
lblClave.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 1).Value
lblUnidad.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 3).Value
lblPrecioU.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 4).Value
lblExistencia.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 5).Value
End Sub
Private Sub lstProductos_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdAgregar_Click
End Sub
Private Sub txtFactura_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Factura As String
Dim Existente As range
Factura = Trim(InputBox("Introduce el nuevo número de factura", "Factura"))
If Factura <> "" And IsNumeric(Factura) Then
Set Existente = fRangoFacturas.Columns("A:A").Find(Factura, , xlValues)
If Existente Is Nothing Then
txtFactura.Text = Factura
Else
MsgBox "Número de factura existente, escoge otro"
End If
End If
End Sub
Private Sub txtFecha_Change()
'Range("B4").Value = txtFecha.Value
End Sub
Private Sub txtImpuesto_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strImpuesto As String
strImpuesto = Trim(InputBox("Introduce el nuevo porcentaje de impuesto", "Impuesto"))
If strImpuesto <> "" And IsNumeric(strImpuesto) Then
Impuesto = Val(strImpuesto)
If Impuesto > 1 And Impuesto < 80 Then
Impuesto = Round(Impuesto / 100, 2)
txtImpuesto = strImpuesto & " %"
End If
End If
End Sub
Private Sub txtSubtotal_Change()
'Range("H20").Value = txtSubtotal.Value
End Sub
Private Sub txtTotal_Change()
'Range("H22").Value = txtTotal.Value
End Sub
Private Sub UserForm_Activate()
Application.StatusBar = "Modulo de facturación"
End Sub
Private Sub UserForm_Initialize()
Dim co1 As Integer
Dim Coor As String
With Calendario
.Value = Now()
txtFecha.Text = Format(.Value, "dd-mmm-yyyy")
.Top = txtFecha.Top + txtFecha.Height
.Left = txtFecha.Left
.Width = 210
.Height = 130
End With
gLibroActual = ActiveWorkbook.Name
gLibroCatalogo = BuscaHoja("Facturacion")
'gLibroCatalogo = BuscaHoja("impresion")
If gLibroCatalogo <> "" Then
With Workbooks(gLibroCatalogo)
Set fRangoFacturas = .Worksheets("Facturacion").Cells(1, 1).CurrentRegion
Set fRangoClientes = .Worksheets("Clientes").Cells(1, 1).CurrentRegion
Set fRangoProductos = .Worksheets("Almacen").Cells(1, 1).CurrentRegion
Set fRangoDetalles = .Worksheets("Detalle").Cells(1, 1).CurrentRegion
Set frangoimpresion = .Worksheets("impresion").Cells(1, 1).CurrentRegion ' se agrego la instruccion siguiente
With fRangoFacturas
txtFactura.Text = Str(Application.WorksheetFunction.Max(.range(.Cells(2, 1), .Cells(.Rows.Count, 1))) + 1)
End With
End With
For co1 = 2 To fRangoClientes.Rows.Count
cboClientes.AddItem fRangoClientes.Cells(co1, 2).Value
Next co1
For co1 = 3 To frangoimpresion.Rows.Count ' cambie el f rango por impresion
lstProductos.AddItem fRangoProductos.Cells(co1, 2).Value 'y active estas 3 lineas
Next co1
Workbooks(gLibroCatalogo).Worksheets("Almacen").Activate
range("B2").End(xlDown).Select
Coor = "B2:B" & Format(Selection.Row)
lstProductos.RowSource = Coor
Workbooks(gLibroCatalogo).Worksheets("Menu Principal").Activate
Else
MsgBox "La hoja Facturacion no existe", vbCritical, "Error"
End
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Res As Integer
If lstDetalle.ListCount > 0 Then
Res = MsgBox("Existen precios en la factura, si sale se cancelara esta factura" _
& vbCrLf & vbCrLf & "¿Deseas salir de todos modos?", vbYesNo, "Salir")
If Res = vbYes Then
cmdQuitarTodos.Tag = "Salir"
cmdQuitarTodos_Click
Erase Factura
Set fRangoFacturas = Nothing
Set fRangoClientes = Nothing
Set fRangoProductos = Nothing
Set frangoimpresion = Nothing
Else
Cancel = True
End If
End If
End Sub
Private Sub AgregaProducto(Cantidad As Single)
lstDetalle.AddItem lstProductos.Text
intNumProductos = lstDetalle.ListCount
ReDim Preserve Factura(intNumProductos)
With Factura(intNumProductos)
.Cantidad = Cantidad
.Posicion = lstProductos.listindex + 2
.Precio = Val(lblPrecioU.Caption)
Subtotal = Round(Subtotal + (.Cantidad * .Precio), 2)
End With
txtSubtotal.Text = Format(Subtotal, "$ #,##0.00")
Impuesto = Round(Val(txtImpuesto.Text) / 100, 2)
Total = Round(Subtotal * (Impuesto + 1), 2)
txtTotal.Text = Format(Total, "$ #,##0.00")
fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value = _
fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value - Cantidad
lblExistencia.Caption = " " & fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value
End Sub
Private Function Existe(pos As Integer) As Boolean
Dim co1 As Integer
On Error GoTo errExiste
For co1 = 1 To UBound(Factura)
If Factura(co1).Posicion = pos Then
Existe = True
Exit Function
End If
Next co1
errExiste:
Err.Clear
Existe = False
End Function
Private Sub UserForm_Terminate()
Application.StatusBar = False
End Sub
Muchas gracias por la respuesta
Hasta pronto
y sepas de lo que te hablo
este código del frm(factura)
Option Explicit
DefInt A-Z
Option Base 1
Private Type Detalle
Cantidad As Single
Precio As Single
Posicion As Integer
End Type
Dim impresion() As Detalle ' lo agrege pensando que la variable seria util
Dim Factura() As Detalle
Dim fRangoFacturas As range
Dim fRangoClientes As range
Dim fRangoProductos As range
Dim fRangoDetalles As range
Dim frangoimpresion As range
Dim datFecha As Date
Dim intNumProductos As Integer
Dim Subtotal As Single
Dim Impuesto As Single
Dim Total As Single
Private Sub Calendario_DblClick()
Dim intRes As Integer
If datFecha > Calendario.Value Then
intRes = MsgBox("La fecha seleccionada es anterior" & vbCrLf & vbCrLf & _
"¿Deseas continuar", vbYesNo + vbQuestion, "Fecha anterior")
If intRes = vbYes Then
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = True
End If
Else
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = True
End If
End Sub
Private Sub Calendario_Exit(ByVal Cancel As MSForms.ReturnBoolean)
imgFecha.SpecialEffect = fmSpecialEffectRaised
Calendario.Visible = False
End Sub
Private Sub cboClientes_Change()
'Workbooks("glibrocatalogo").Worksheets("impresion").Activate
'Sheets(Array("impresion")).Select
'Range("C2").Value = cboClientes.Value
End Sub
'Private Sub cboClientes_Click()
'Sheets(Array("impresion")).Activate
'Range("C2").Value = cboClientes.Value
'End Sub
Private Sub cmdAgregar_Click()
Dim Cantidad As String
Dim co1 As Integer
If lstProductos.listindex > -1 Then
If Val(lblExistencia.Caption) > 0 Then
Cantidad = InputBox("Introduce la cantidad", "Cantidad", "1")
If Cantidad <> "" And IsNumeric(Cantidad) Then
If Abs(Val(Cantidad)) <= Val(Trim(lblExistencia.Caption)) Then
If Not Existe(lstProductos.listindex + 2) Then
AgregaProducto (Abs(Val(Cantidad)))
Else
MsgBox "El producto ya esta en la factura", vbInformation
End If
Else
MsgBox "La cantidad debe ser menor o igual a la existencia", vbCritical, "No valido"
End If
Else
MsgBox "La cantidad debe ser un número", vbInformation, "No valido"
End If
Else
MsgBox "No hay producto en existencia", vbInformation, "Sin existencia"
End If
Else
MsgBox "No hay producto seleccionado"
End If
End Sub
Private Sub cmdCalculadora_Click()
Dim RetornarValor 'As Double
Dim Ejecutando 'As Long
On Error GoTo ControlError
'Busca si ya esta en ejecución la calculadora
Ejecutando = FindWindow(vbNullString, "Calculadora")
If Ejecutando = 0 Then
RetornarValor = Shell("C:\WINDOWS\CALC.EXE") ' Ejecuta la Calculadora.
AppActivate RetornarValor, False
Else
AppActivate "Calculadora", False 'Solo la activa
End If
Exit Sub
ControlError:
Err.Clear
End Sub
Private Sub cmdFactura_Click()
Dim NuevaFila As Integer
Dim co1 As Integer
Dim co2 As Integer
Dim range As range
Dim frangodetalle As sheImpresion
Dim cell As Boolean
If cboClientes.listindex > -1 Then
If lstDetalle.ListCount > 0 Then
With fRangoFacturas
NuevaFila = .Rows.Count + 1
.Cells(NuevaFila, 1).Value = Val(txtFactura.Text)
.Cells(NuevaFila, 2).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 2).Value 'DA EL NOMBRE EN LA HOJA DE FACTURA EL 2
.Cells(NuevaFila, 3).Value = txtFecha.Text
.Cells(NuevaFila, 4).Value = Round(Subtotal, 2)
.Cells(NuevaFila, 5).Value = Round(Impuesto * 100, 2)
.Cells(NuevaFila, 6).Value = Round(Total, 2)
.Cells(NuevaFila, 7).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 1).Value ' TIENE QUE DAR LA CLAVE DE CLIENTE DES PUES DEL P.U.
.Cells(NuevaFila, 8).Value = fRangoClientes.Cells(cboClientes.listindex + 1, 3).Value
End With
txtFactura.Text = Str(Val(txtFactura.Text) + 1)
Set fRangoFacturas = Workbooks(gLibroCatalogo).Worksheets("Facturacion").Cells(1, 1).CurrentRegion
With fRangoDetalles
For co1 = 1 To UBound(Factura) ' a qui empieza a llenar la hoja de DETALLE
.Cells(.Rows.Count + co1, 1).Value = Val(txtFactura.Text) ' esto pone el valor del numero de la factura
.Cells(.Rows.Count + co1, 2).Value = fRangoProductos.Cells(Factura(co1).Posicion, 1) ' aqui se pasa el valor de los productos
.Cells(.Rows.Count + co1, 3).Value = fRangoProductos.Cells(Factura(co1).Posicion, 2)
.Cells(.Rows.Count + co1, 4).Value = fRangoProductos.Cells(Factura(co1).Posicion, 3)
.Cells(.Rows.Count + co1, 8).Value = fRangoClientes.Cells(cboClientes.listindex + 2, 2).Value ' este es el nobre del cliente
.Cells(.Rows.Count + co1, 5).Value = Factura(co1).Cantidad
.Cells(.Rows.Count + co1, 6).Value = Factura(co1).Precio
Next co1
End With
Set fRangoDetalles = Workbooks(gLibroCatalogo).Worksheets("Detalle").Cells(1, 1).CurrentRegion
cboClientes.listindex = -1
'lstDetalle.Clear
' AQUI EMPIEZAN MIS PROBLEMAS
'aquí debieras agregar esto
With frangoimpresion
For co1 = 1 To UBound(Factura) ' a qui empieza a llenar la hoja de DETALLE
'.Cells(.Rows.Count + co1, 1).Value = Val(txtFactura.Text) ' esto pone el valor del numero de la factura
.Cells(.Rows.Count + co1, 7).Value = fRangoProductos.Cells(Factura(co1).Posicion, 4) ' aqui se pasa el valor de los productos
.Cells(.Rows.Count + co1, 3).Value = fRangoProductos.Cells(Factura(co1).Posicion, 2)
.Cells(.Rows.Count + co1, 2).Value = Factura(co1).Cantidad
.range("c2").Value = cboClientes.Value
.range("B4").Value = txtFecha.Value
.range("h20").Value = txtSubtotal.Value
.range("h22").Value = txtTotal.Value
'.cells("C2").Value = fRangoClientes.Cells(cboClientes.listindex + 2, 2).Value ' este es el nobre del cliente
'.Cells(.Rows.Count + co1, 5).Value = Factura(co1).Cantidad
'.Cells(.Rows.Count + co1, 7).Value = Factura(co1).Precio
Next co1
End With
Set frangoimpresion = Workbooks(gLibroCatalogo).Worksheets("impresion").Cells(1, 1).CurrentRegion
cboClientes.listindex = -1
'NuevaFila = .Rows.Count + 1
'.Cells(NuevaFila, 2).Value = txtFecha.Text
'.Cells(NuevaFila, 6).Value = Round(Total, 5)
'.Cells(NuevaFila, 4).Value = Round(Subtotal, 2)
'For co1 = 1 To UBound(impresion)
'.Cells(.Rows.Count + co1, 8).Value = frangoimpresion.Cells(impresion(co1).Posicion, 1)
'.Cells(.Rows.Count + co1, 9).Value = frangoimpresion(col).Precio
'range("c2").Value = cboClientes.Value
'range("B4").Value = txtFecha.Value
'range("h20").Value = txtSubtotal.Value
'range("h22").Value = txtTotal.Value
'range("D7").Value = frangodetalle.Value
'Set frangoimpresion = Workbooks(gLibroCatalogo).Worksheets("impresion").Cells(1, 1).CurrentRegion
'Next co1
'End With
'Else
'Erase Factura
MsgBox " los datos son correctos"
MsgBox "Factura registrada correctamente"
lstProductos.SetFocus
Else
MsgBox "No se han agregado productos"
End If
Else
MsgBox "Debes escoger un cliente"
End If
End Sub
Private Sub cmdFactura_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
End Sub
Private Sub cmdQuitar_Click()
Dim Cantidad As Single
Dim Res As Integer
Dim co1 As Integer
Dim PosPrecio As Integer
Dim NumPrecio As Integer
If lstDetalle.ListCount > 0 Then
NumPrecio = lstDetalle.listindex + 1
PosPrecio = Factura(NumPrecio).Posicion
Cantidad = Factura(NumPrecio).Cantidad
Res = MsgBox("Estas seguro de quitar este precio", vbYesNo, "Quitar")
If Res = vbYes Then
With fRangoProductos
.Cells(PosPrecio, 5).Value = .Cells(PosPrecio, 5).Value + Cantidad
End With
lstDetalle.RemoveItem lstDetalle.listindex
Subtotal = Subtotal - (Cantidad * Factura(NumPrecio).Precio)
txtSubtotal.Text = Format(Subtotal, "$ #,##0.00")
Impuesto = Round(Val(txtImpuesto.Text) / 100, 2)
Total = Subtotal * (Impuesto + 1)
txtTotal.Text = Format(Total, "$ #,##0.00")
If NumPrecio < UBound(Factura) Then
For co1 = NumPrecio To UBound(Factura) - 1
Factura(co1) = Factura(co1 + 1)
Next co1
End If
If lstDetalle.ListCount > 0 Then
ReDim Preserve Factura(UBound(Factura) - 1)
Else
Erase Factura
End If
With lstProductos
.SetFocus
.listindex = PosPrecio - 2
End With
lstProductos_Click
End If
End If
End Sub
Private Sub cmdQuitarTodos_Click()
Dim Res As Integer
Dim co1 As Integer
If cmdQuitarTodos.Tag = "" Then
If lstDetalle.ListCount > 0 Then
Res = MsgBox("Estas seguro de quitar todos los precios", vbYesNo, "Vaciar")
Else
Res = 7
End If
End If
If Res = 0 Or Res = vbYes Then
For co1 = 1 To UBound(Factura)
fRangoProductos.Cells(Factura(co1).Posicion, 5).Value = _
fRangoProductos.Cells(Factura(co1).Posicion, 5).Value + _
Factura(co1).Cantidad
Next co1
lstDetalle.Clear
Erase Factura
Subtotal = 0
Total = 0
txtSubtotal.Text = ""
txtTotal.Text = ""
MsgBox "Se han quitado todos los precios"
End If
End Sub
Private Sub imgFecha_Click()
If Calendario.Visible Then
txtFecha.Text = Format(Calendario.Value, "dd-mmm-yyyy")
Calendario.Visible = False
imgFecha.SpecialEffect = fmSpecialEffectRaised
Else
datFecha = CDate(txtFecha.Text)
imgFecha.SpecialEffect = fmSpecialEffectSunken
Calendario.Visible = True
Calendario.ZOrder
Calendario.SetFocus
End If
End Sub
Private Sub imprimir_Click()
Dim Celdainicial As Variant
Dim co1 As Integer
Dim col As Integer
Dim fila As Integer
'Dim txtfechas As Date
Worksheets("impresion").Select
'Dim cboClientes As Single
'Dim range As Integer
Celdainicial = "b4" ' aqui va moviendo la celda para pegar la fecha
Set Celdainicial = range(Celdainicial)
col = Celdainicial.Column
'bbusca cual es la ultima fila
fila = Celdainicial.End(xlDown).Row - 0
' comienza a copiar los valores
Cells(fila, col).Value = txtFecha.Value
range("c2").Value = cboClientes.Value
range("h20").Value = txtTotal.Value
Set Celdainicial = Nothing
End Sub
Private Sub lblClave_Click()
End Sub
Private Sub lblExistencia_Click()
End Sub
Private Sub lblFecha_Click()
End Sub
Private Sub lblInfo1_Click()
End Sub
Private Sub lblInfo5_Click()
End Sub
Private Sub lblPrecioU_Click()
End Sub
Private Sub lstDetalle_Click()
lblInfo4.Caption = "Cantidad"
lblClave.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 1).Value
lblUnidad.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 3).Value
lblPrecioU.Caption = " " & fRangoProductos.Cells(Factura(lstDetalle.listindex + 1).Posicion, 4).Value
lblExistencia.Caption = " " & Factura(lstDetalle.listindex + 1).Cantidad
End Sub
Private Sub lstDetalle_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdQuitar_Click
End Sub
Private Sub lstDetalle_Enter()
If lstDetalle.ListCount > 0 Then
lblInfo4.Caption = "Cantidad"
End If
End Sub
Private Sub lstProductos_Click()
lblInfo4.Caption = "Existencia"
lblClave.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 1).Value
lblUnidad.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 3).Value
lblPrecioU.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 4).Value
lblExistencia.Caption = " " & fRangoProductos.Cells(lstProductos.listindex + 2, 5).Value
End Sub
Private Sub lstProductos_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdAgregar_Click
End Sub
Private Sub txtFactura_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Factura As String
Dim Existente As range
Factura = Trim(InputBox("Introduce el nuevo número de factura", "Factura"))
If Factura <> "" And IsNumeric(Factura) Then
Set Existente = fRangoFacturas.Columns("A:A").Find(Factura, , xlValues)
If Existente Is Nothing Then
txtFactura.Text = Factura
Else
MsgBox "Número de factura existente, escoge otro"
End If
End If
End Sub
Private Sub txtFecha_Change()
'Range("B4").Value = txtFecha.Value
End Sub
Private Sub txtImpuesto_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strImpuesto As String
strImpuesto = Trim(InputBox("Introduce el nuevo porcentaje de impuesto", "Impuesto"))
If strImpuesto <> "" And IsNumeric(strImpuesto) Then
Impuesto = Val(strImpuesto)
If Impuesto > 1 And Impuesto < 80 Then
Impuesto = Round(Impuesto / 100, 2)
txtImpuesto = strImpuesto & " %"
End If
End If
End Sub
Private Sub txtSubtotal_Change()
'Range("H20").Value = txtSubtotal.Value
End Sub
Private Sub txtTotal_Change()
'Range("H22").Value = txtTotal.Value
End Sub
Private Sub UserForm_Activate()
Application.StatusBar = "Modulo de facturación"
End Sub
Private Sub UserForm_Initialize()
Dim co1 As Integer
Dim Coor As String
With Calendario
.Value = Now()
txtFecha.Text = Format(.Value, "dd-mmm-yyyy")
.Top = txtFecha.Top + txtFecha.Height
.Left = txtFecha.Left
.Width = 210
.Height = 130
End With
gLibroActual = ActiveWorkbook.Name
gLibroCatalogo = BuscaHoja("Facturacion")
'gLibroCatalogo = BuscaHoja("impresion")
If gLibroCatalogo <> "" Then
With Workbooks(gLibroCatalogo)
Set fRangoFacturas = .Worksheets("Facturacion").Cells(1, 1).CurrentRegion
Set fRangoClientes = .Worksheets("Clientes").Cells(1, 1).CurrentRegion
Set fRangoProductos = .Worksheets("Almacen").Cells(1, 1).CurrentRegion
Set fRangoDetalles = .Worksheets("Detalle").Cells(1, 1).CurrentRegion
Set frangoimpresion = .Worksheets("impresion").Cells(1, 1).CurrentRegion ' se agrego la instruccion siguiente
With fRangoFacturas
txtFactura.Text = Str(Application.WorksheetFunction.Max(.range(.Cells(2, 1), .Cells(.Rows.Count, 1))) + 1)
End With
End With
For co1 = 2 To fRangoClientes.Rows.Count
cboClientes.AddItem fRangoClientes.Cells(co1, 2).Value
Next co1
For co1 = 3 To frangoimpresion.Rows.Count ' cambie el f rango por impresion
lstProductos.AddItem fRangoProductos.Cells(co1, 2).Value 'y active estas 3 lineas
Next co1
Workbooks(gLibroCatalogo).Worksheets("Almacen").Activate
range("B2").End(xlDown).Select
Coor = "B2:B" & Format(Selection.Row)
lstProductos.RowSource = Coor
Workbooks(gLibroCatalogo).Worksheets("Menu Principal").Activate
Else
MsgBox "La hoja Facturacion no existe", vbCritical, "Error"
End
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Res As Integer
If lstDetalle.ListCount > 0 Then
Res = MsgBox("Existen precios en la factura, si sale se cancelara esta factura" _
& vbCrLf & vbCrLf & "¿Deseas salir de todos modos?", vbYesNo, "Salir")
If Res = vbYes Then
cmdQuitarTodos.Tag = "Salir"
cmdQuitarTodos_Click
Erase Factura
Set fRangoFacturas = Nothing
Set fRangoClientes = Nothing
Set fRangoProductos = Nothing
Set frangoimpresion = Nothing
Else
Cancel = True
End If
End If
End Sub
Private Sub AgregaProducto(Cantidad As Single)
lstDetalle.AddItem lstProductos.Text
intNumProductos = lstDetalle.ListCount
ReDim Preserve Factura(intNumProductos)
With Factura(intNumProductos)
.Cantidad = Cantidad
.Posicion = lstProductos.listindex + 2
.Precio = Val(lblPrecioU.Caption)
Subtotal = Round(Subtotal + (.Cantidad * .Precio), 2)
End With
txtSubtotal.Text = Format(Subtotal, "$ #,##0.00")
Impuesto = Round(Val(txtImpuesto.Text) / 100, 2)
Total = Round(Subtotal * (Impuesto + 1), 2)
txtTotal.Text = Format(Total, "$ #,##0.00")
fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value = _
fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value - Cantidad
lblExistencia.Caption = " " & fRangoProductos.Cells(Factura(intNumProductos).Posicion, 5).Value
End Sub
Private Function Existe(pos As Integer) As Boolean
Dim co1 As Integer
On Error GoTo errExiste
For co1 = 1 To UBound(Factura)
If Factura(co1).Posicion = pos Then
Existe = True
Exit Function
End If
Next co1
errExiste:
Err.Clear
Existe = False
End Function
Private Sub UserForm_Terminate()
Application.StatusBar = False
End Sub
Muchas gracias por la respuesta
Hasta pronto
