Escribir por teclado en un datagrid
xsara
16 de Noviembre del 2002
Hola amigos, alguien sabe como puedo hacer para que en un formulario además de ver datos en un datagrid, se pueden modificar o escribir nuevos desde el teclado? Gracias
Raul
16 de Noviembre del 2002
es muy sencillo. únicamente tienes que permitir la propiedad de escribir en el control, en lazar el control a un origen de datos. Cada vez que cambies de linea en el datagrid se actualizan los datos. no tiene ninguna dificultad, incluso puedes controlar los eventos de actualizacion para controlar el tipo de datos que metes. te mando el código que tengo metido en un formulario de un programa de facturación que mete articulos por un datagrid
Public posicion, saveart As String, posicion_anterior As Variant
Public columna As Integer
Dim rsborrar As New ADODB.Recordset, rs As Recordset, guardarok As String
Private Sub SumaTotal()
' calculamos el total de la factura
' con la propiedad formatNumber hacemos que ponga dos decimales
' hay que cambiar el el sistema el formmato de número a #,###,###.##
Dim sum, TS As Double, TI As Double
If rs.RecordCount > 0 Then rs.MoveFirst
If Not rs.EOF Then
Do Until rs.EOF
sum = rs("Total") + sum
rs.MoveNext
Loop
Total_Suma = sum
Total_Suma = FormatNumber(Total_Suma, 2)
Else
If rs.RecordCount = 0 Then Total_Suma = 0
End If
If iva = "" Then iva = 0
cobrado = FormatNumber(cobrado, 2)
total_iva = sum * iva / 100
total_iva = FormatNumber(total_iva, 2)
TS = Total_Suma
TI = total_iva
total_factura.Text = TS + TI
total_factura = FormatNumber(total_factura, 2)
TS = total_factura
TI = cobrado
resto = TS - TI
resto = FormatNumber(resto, 2)
End Sub
Private Sub precio()
'comparamos el articulo para saver si le hemos cambiado y actualizar el precio
Dim precio As Double
If saveart = "" Then
precio = FormatNumber(rsArtFactura("Precio"), 2)
rsArtFactura("PVP") = precio
Else
If saveart <> rsArtFactura("Articulo") Then rsArtFactura("PVP") = rsArtFactura("Precio")
End If
End Sub
Private Sub total()
'Calculamos el total
If Not IsNull(rsArtFactura("cantidad")) And Not IsNull(rsArtFactura("PVP")) Then
If IsNull(rsArtFactura("Descuento")) Then
rsArtFactura("Total") = rsArtFactura("cantidad") * rsArtFactura("PVP")
Else
rsArtFactura("Total") = (rsArtFactura("cantidad") * rsArtFactura("PVP")) - (rsArtFactura("cantidad") * rsArtFactura("PVP") * rsArtFactura("Descuento") / 100)
End If
End If
End Sub
Private Sub borrar_Click()
'para borrar un articulo debemos de hacerlo con un recorset secundario
'ya que con la jerarquia crea problemas
Dim sql, pregunta
pregunta = MsgBox("Desea borrar este artículo", vbYesNo, "¡¡Atención!!")
If pregunta = vbYes Then
If rsArtFactura.RecordCount > 0 Then
sql = "delete * from Articulos_Factura where Id= " & rsArtFactura("Id")
With rsborrar
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'refrescamos los articulos y refrescamos la cuadricula, no se puede hacer con Refresh
rsArtFactura.Requery
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
Set Cuadricula.DataSource = rsArtFactura
rs.Requery
SumaTotal
saveart = ""
End If
End If
End Sub
Private Sub calendario_DateClick(ByVal DateClicked As Date)
fecha = calendario
calendario.Visible = False
End Sub
Private Sub calendario_KeyPress(KeyAscii As Integer)
' si pulsamos tecla Esc se esconde
If KeyAscii = 27 Then calendario.Visible = False
End Sub
Private Sub client_expe_Click()
End Sub
Private Sub cobrado_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub cobrado_Validate(Cancel As Boolean)
'al cambiar cantidad cobrada recalculamos
SumaTotal
End Sub
Private Sub actualizar_articulo()
On Error GoTo Error
Dim posicion As Variant
'si no hemos asignado factura
If IsNull(rsArtFactura("Id_Factura_Art")) Then rsArtFactura("Id_Factura_Art") = rsFactura("Id_factura")
'calculamos el total
total
rsArtFactura.Update
'guardamos la posicion del recordset
posicion = rsArtFactura.Bookmark
rsArtFactura.Requery
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
'posicionamos de nuevo el recordset
rsArtFactura.Bookmark = posicion
'para sver si estamos en el mismo registro y no debeemos de actualizar el precio
If Not posicion_anterior = 0 Then
If posicion_anterior <> posicion Then savart = ""
End If
'asignación del precio del articulo
precio
rs.Requery
SumaTotal
rsArtFactura.Bookmark = posicion
posicion_anterior = posicion
exit_cuadricula:
Exit Sub
Error:
MsgBox Err.Description
Resume exit_cuadricula
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Cuadricula_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
columna = ColIndex
End Sub
Private Sub Cuadricula_DblClick()
saveart = ""
Error = "si"
llamada = "Factura"
List_Articulos.Show vbModal
If Error = "no" Then
actualizar_articulo
total
SumaTotal
End If
End Sub
Private Sub Cuadricula_KeyPress(KeyAscii As Integer)
'If columna <> 5 Then Exit Sub
'If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub eliminar_Click()
Dim pregunta As String
pregunta = MsgBox("¿Desea elimar la factura?", vbYesNo, "Eliminar factura")
If pregunta = vbYes Then eliminar_factura
End Sub
Private Sub eliminar_factura()
If rsArtFactura.RecordCount > 0 Then
sql = "delete * from Articulos_Factura where Id_factura_Art= " & rsFactura("Id_factura")
With rsborrar
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'refrescamos los articulos y refrescamos la cuadricula, no se puede hacer con Refresh
rsArtFactura.Requery
End If
rsFactura.Delete
rsFactura.Requery
Unload Me
End Sub
Private Sub Id_Cliente_DblClick()
llamada = "Factura"
rsClientes.Filter = ""
List_Clientes.Show vbModal
datos_Cliente
End Sub
Private Sub imprimir_Click()
On Error GoTo Error
Dim sql
'guardamos los datos
guardarok = ""
guardar
If guardarok <> "si" Then Exit Sub
'comando sql con el que optenemos todos los datos
sql = "SELECT Numero_Factura.N_Factura, Numero_Factura.Id_Factura, Numero_Factura.Fecha, Numero_Factura.SubTotal, Numero_Factura.Cobrado, Numero_Factura.Resto, Numero_Factura.IVA, Numero_Factura.TotalIVa, Numero_Factura.Total, Numero_Factura.Observaciones, Articulos_Factura.Descuento, Articulos_Factura.Articulo, Articulos.Descripcion, Articulos_Factura.PVP, Articulos_Factura.Cantidad, Articulos_Factura.Descuento, Articulos_Factura.Total AS Total_Art, Clientes.Nombre, Clientes.Direccion, Clientes.CP, Clientes.Localidad, Clientes.Provincia, Clientes.NIF " _
& " FROM (Clientes INNER JOIN Numero_Factura ON Clientes.Id = Numero_Factura.Id_cliente) INNER JOIN (Articulos INNER JOIN Articulos_Factura ON Articulos.Codigo = Articulos_Factura.Articulo) ON Numero_Factura.Id_Factura = Articulos_Factura.Id_Factura_Art " _
& " where Numero_Factura.Id_factura=" & rsFactura("Id_Factura")
'abrimos el rs
With rsInforme
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'aplicamos el rs al informe
Set factura_report.DataSource = rsInforme
'si no tiene articulos salimos de la impresión
If rsInforme.RecordCount = 0 Then
MsgBox "Factura sin datos", , "Impresión de factura"
rsInforme.Close
Exit Sub
End If
'asignamos los datos
With factura_report.Sections("Sección4")
.Controls("n_factura").Caption = rsInforme("N_Factura")
.Controls("nombre").Caption = rsInforme("Nombre")
.Controls("direccion").Caption = rsInforme("direccion")
.Controls("localidad").Caption = rsInforme("Localidad")
.Controls("provincia").Caption = rsInforme("Provincia")
'modificado por problemas en la impresion
'If rsInforme("CP") Or rsInforme("CP") <> Null Then .Controls("cp").Caption = rsInforme("CP")
'If rsInforme("NIF") <> "" Then .Controls("nif").Caption = rsInforme("NIF")
.Controls("cp").Caption = Factura.CP_Cliente
.Controls("nif").Caption = Factura.NIF_Cliente
.Controls("fecha").Caption = rsInforme("fecha")
End With
If Not IsNull(rsInforme("Observaciones")) Then factura_report.Sections("Sección5").Controls("comentario").Caption = rsInforme("Observaciones")
With factura_report.Sections("Sección3")
.Controls("subtotal").Caption = FormatNumber(rsInforme("SubTotal"), 2) & " "
.Controls("iva").Caption = rsInforme("IVA")
.Controls("totaliva").Caption = FormatNumber(rsInforme("TotalIva"), 2) & " "
.Controls("cobrado").Caption = FormatNumber(rsInforme("Cobrado"), 2) & " "
.Controls("resto").Caption = FormatNumber(rsInforme("Resto"), 2) & " "
.Controls("total").Caption = FormatNumber(rsInforme("Total"), 2) & " "
End With
'visualizamos el informe
factura_report.Show vbModal
rsInforme.Close
Exit Sub
Error:
MsgBox Err.Description
Resume Next
End Sub
Private Sub Cuadricula_AfterColUpdate(ByVal ColIndex As Integer)
'actualizar la cuadricula
actualizar_articulo
End Sub
Private Sub Cuadricula_ColEdit(ByVal ColIndex As Integer)
' almacenamos el articulo para saver si ha cambiado
If Not IsNull(rsArtFactura("Articulo")) And rsArtFactura.RecordCount > 0 Then
saveart = rsArtFactura("Articulo")
End If
End Sub
Private Sub fecha_DblClick()
calendario.Value = DateValue(Now)
calendario.Visible = True
End Sub
Private Sub fecha_KeyPress(KeyAscii As Integer)
' si pulsamos tecla Esc se esconde
If KeyAscii = 27 Then calendario.Visible = False
End Sub
Private Sub Form_Load()
'eliminar los filtros
rsArtFactura.Filter = ""
rsClientes.Filter = ""
If action = "nueva" Then
'crear una factura nueva
'pregunta:
'If Not rsFactura.RecordCount = 0 Then
'rsFactura.Requery
'rsFactura.MoveLast
'Id_factura = rsFactura("N_Factura") + 1
'Else
'Id_factura = InputBox("Ha de inicializar el número de factura", "Atención")
'End If
ClassIni.Bloque = "Numero"
Id_factura = ClassIni.Leer("Factura")
Id_factura.Enabled = False
'If Id_factura <> "" Then
datos_factura
fecha = DateValue(Now)
posicion_anterior = 0
'Else
'GoTo pregunta
'End If
Else
'buscar factura
If action = "buscar" Then
Id_factura = numero
datos_factura
fecha = rsFactura("Fecha")
'Total_Suma = rsFactura("SubTotal")
'resto = rsFactura("Resto")
cobrado = rsFactura("Cobrado")
'iva = rsFactura("iva")
'total_factura = rsFactura("Total")
'total_iva = rsFactura("TotalIva")
SumaTotal
Id_factura.Enabled = False
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
rsArtFactura.Filter = ""
rsFactura.Filter = ""
rsClientes.Filter = ""
'Principal.Enabled = True
End Sub
Private Sub datos_Cliente()
'Mostrar los datos del cliente
If Id_Cliente <> "" Then
rsClientes.Filter = "Id= " & Id_Cliente
'y comprovamos que el número exista
If rsClientes.RecordCount > 0 Then
Nombre_Cliente = rsClientes("Nombre")
Direccion_Cliente = rsClientes("Direccion")
'si el codigo postal no existe da error, pero lo controlamos
If Not IsNull(rsClientes("CP")) Then
CP_Cliente = rsClientes("CP")
Else
CP_Cliente = ""
End If
Localidad_Cliente = rsClientes("Localidad")
Provincia_Cliente = rsClientes("Provincia")
If Not IsNull(rsClientes("NIF")) Then
NIF_Cliente = rsClientes("NIF")
Else
NIF_Cliente = ""
End If
'controlar que el telefono no es nulo
If Not IsNull(rsClientes("Telefono_Fijo")) Then
Telefono_Cliente = rsClientes("Telefono_Fijo")
Else
Telefono_Cliente = ""
End If
Else
MsgBox "No existe el cliente", , "¡¡Atención!!"
End If
Else
'si no existe el cliente borramos los campos de dato de cliente
Nombre_Cliente = ""
Direccion_Cliente = ""
CP_Cliente = ""
Localidad_Cliente = ""
Provincia_Cliente = ""
NIF_Cliente = ""
Telefono_Cliente = ""
End If
End Sub
Private Sub Id_Cliente_Validate(Cancel As Boolean)
'Actualizar el cliente
datos_Cliente
End Sub
Private Sub datos_factura()
Dim sql
If action = "nueva" Then
rsFactura.AddNew
rsFactura("N_Factura") = Id_factura
rsFactura.Update
rsFactura.Requery
rsFactura.MoveLast
'filtramos los articulos, para que no salga niguno que no pertenecca a la factura actual
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
Cuadricula.Enabled = True
Set rs = rsArtFactura
Set Cuadricula.DataSource = rsArtFactura
Cuadricula.ReBind
With Cuadricula
'titulo que aparece en la cuadricula
.Caption = "Artículos Facturados"
End With
Else
If action = "buscar" Then
'cerramos y abrimos rsFactura con el número de factura que buscamos
Id_Cliente = rsFactura("Id_Cliente")
datos_Cliente
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
If rsFactura("observaciones") <> "" Then SubFactura_texto = rsFactura("Observaciones")
Cuadricula.Enabled = True
Set rs = rsArtFactura
Set Cuadricula.DataSource = rsArtFactura
Cuadricula.ReBind
With Cuadricula
'titulo que aparece en la cuadricula
.Caption = "Artículos Facturados"
End With
If Not IsNull(rsFactura("N_Presupuesto")) Then n_pre = rsFactura("N_presupuesto")
End If
End If
End Sub
Private Sub Id_factura_Validate(Cancel As Boolean)
'cuando tenemos número de factura fitramos los articulos y activamos la cuadricula
datos_factura
End Sub
Private Sub iva_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub iva_Validate(Cancel As Boolean)
'recalculo del total
SumaTotal
End Sub
Private Sub mostrar_art_Click()
saveart = ""
Error = "si"
llamada = "Factura"
List_Articulos.Show vbModal
If Error = "no" Then
actualizar_articulo
total
SumaTotal
End If
End Sub
Private Sub nuevo_cliente_Click()
Cliente.Show vbModal
End Sub
Private Sub salir_Click()
Dim respuesta
If action = "nueva" Then
respuesta = MsgBox("¿Desea grabar los datos de la factura?", vbYesNoCancel, "¡¡Atención!!")
Else: respuesta = vbYes
End If
'en caso de querer grabar comprobamos que estén todos los datos
'garbamos el total sin sumarle el iva
If respuesta = vbYes Then
guardar
If guardarok = "si" Then
If action = "nueva" Then
ClassIni.Bloque = "Numero"
Call ClassIni.Escribir("Factura", ClassIni.Leer("Factura") + 1)
End If
Unload Factura
End If
Exit Sub
'si cancelamos, volvemos a la factura
ElseIf respuesta = vbCancel Then
Exit Sub
End If
'si no, salimos sin grabar
If action = "nueva" Then eliminar_factura
Unload Factura
End Sub
Private Sub guardar()
On Error GoTo error_guardar
Dim cantidad As Double
If Id_factura <> "" And Id_Cliente <> "" Then
'resto = total_factura - cobrado
rsFactura("N_Factura") = Id_factura
rsFactura("Id_cliente") = Id_Cliente
cantidad = cobrado
rsFactura("Cobrado") = cantidad
cantidad = resto
rsFactura("Resto") = cantidad
cantidad = Total_Suma
rsFactura("SubTotal") = cantidad
cantidad = iva
rsFactura("iva") = cantidad
cantidad = total_factura
rsFactura("Total") = cantidad
cantidad = total_iva
rsFactura("TotalIva") = cantidad
rsFactura("Fecha") = fecha
rsFactura("Tipo_Factura") = "Factura"
If Not SubFactura_texto = "" Then rsFactura("Observaciones") = SubFactura_texto
rsFactura.Update
guardarok = "si"
Exit Sub
Else
'si falta algun dato cancelamos la operación
MsgBox "Ha de rellenar todos los datos", , "¡¡Atención!!"
guardarok = "no"
Exit Sub
End If
Exit Sub
error_guardar:
MsgBox Err.Description, , "Error al guadar"
Resume Next
End Sub
Private Sub sobre_Click()
If Nombre_Cliente = "" Then Exit Sub
Set Sobre_report.DataSource = rsClientes
With Sobre_report.Sections("Sección2")
.Controls("Etiqueta1").Caption = Nombre_Cliente
.Controls("Etiqueta2").Caption = Direccion_Cliente
.Controls("Etiqueta3").Caption = CP_Cliente & " " & Localidad_Cliente
.Controls("Etiqueta4").Caption = "(" & Provincia_Cliente & ")"
End With
Sobre_report.Show vbModal
End Sub
Public posicion, saveart As String, posicion_anterior As Variant
Public columna As Integer
Dim rsborrar As New ADODB.Recordset, rs As Recordset, guardarok As String
Private Sub SumaTotal()
' calculamos el total de la factura
' con la propiedad formatNumber hacemos que ponga dos decimales
' hay que cambiar el el sistema el formmato de número a #,###,###.##
Dim sum, TS As Double, TI As Double
If rs.RecordCount > 0 Then rs.MoveFirst
If Not rs.EOF Then
Do Until rs.EOF
sum = rs("Total") + sum
rs.MoveNext
Loop
Total_Suma = sum
Total_Suma = FormatNumber(Total_Suma, 2)
Else
If rs.RecordCount = 0 Then Total_Suma = 0
End If
If iva = "" Then iva = 0
cobrado = FormatNumber(cobrado, 2)
total_iva = sum * iva / 100
total_iva = FormatNumber(total_iva, 2)
TS = Total_Suma
TI = total_iva
total_factura.Text = TS + TI
total_factura = FormatNumber(total_factura, 2)
TS = total_factura
TI = cobrado
resto = TS - TI
resto = FormatNumber(resto, 2)
End Sub
Private Sub precio()
'comparamos el articulo para saver si le hemos cambiado y actualizar el precio
Dim precio As Double
If saveart = "" Then
precio = FormatNumber(rsArtFactura("Precio"), 2)
rsArtFactura("PVP") = precio
Else
If saveart <> rsArtFactura("Articulo") Then rsArtFactura("PVP") = rsArtFactura("Precio")
End If
End Sub
Private Sub total()
'Calculamos el total
If Not IsNull(rsArtFactura("cantidad")) And Not IsNull(rsArtFactura("PVP")) Then
If IsNull(rsArtFactura("Descuento")) Then
rsArtFactura("Total") = rsArtFactura("cantidad") * rsArtFactura("PVP")
Else
rsArtFactura("Total") = (rsArtFactura("cantidad") * rsArtFactura("PVP")) - (rsArtFactura("cantidad") * rsArtFactura("PVP") * rsArtFactura("Descuento") / 100)
End If
End If
End Sub
Private Sub borrar_Click()
'para borrar un articulo debemos de hacerlo con un recorset secundario
'ya que con la jerarquia crea problemas
Dim sql, pregunta
pregunta = MsgBox("Desea borrar este artículo", vbYesNo, "¡¡Atención!!")
If pregunta = vbYes Then
If rsArtFactura.RecordCount > 0 Then
sql = "delete * from Articulos_Factura where Id= " & rsArtFactura("Id")
With rsborrar
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'refrescamos los articulos y refrescamos la cuadricula, no se puede hacer con Refresh
rsArtFactura.Requery
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
Set Cuadricula.DataSource = rsArtFactura
rs.Requery
SumaTotal
saveart = ""
End If
End If
End Sub
Private Sub calendario_DateClick(ByVal DateClicked As Date)
fecha = calendario
calendario.Visible = False
End Sub
Private Sub calendario_KeyPress(KeyAscii As Integer)
' si pulsamos tecla Esc se esconde
If KeyAscii = 27 Then calendario.Visible = False
End Sub
Private Sub client_expe_Click()
End Sub
Private Sub cobrado_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub cobrado_Validate(Cancel As Boolean)
'al cambiar cantidad cobrada recalculamos
SumaTotal
End Sub
Private Sub actualizar_articulo()
On Error GoTo Error
Dim posicion As Variant
'si no hemos asignado factura
If IsNull(rsArtFactura("Id_Factura_Art")) Then rsArtFactura("Id_Factura_Art") = rsFactura("Id_factura")
'calculamos el total
total
rsArtFactura.Update
'guardamos la posicion del recordset
posicion = rsArtFactura.Bookmark
rsArtFactura.Requery
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
'posicionamos de nuevo el recordset
rsArtFactura.Bookmark = posicion
'para sver si estamos en el mismo registro y no debeemos de actualizar el precio
If Not posicion_anterior = 0 Then
If posicion_anterior <> posicion Then savart = ""
End If
'asignación del precio del articulo
precio
rs.Requery
SumaTotal
rsArtFactura.Bookmark = posicion
posicion_anterior = posicion
exit_cuadricula:
Exit Sub
Error:
MsgBox Err.Description
Resume exit_cuadricula
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Cuadricula_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
columna = ColIndex
End Sub
Private Sub Cuadricula_DblClick()
saveart = ""
Error = "si"
llamada = "Factura"
List_Articulos.Show vbModal
If Error = "no" Then
actualizar_articulo
total
SumaTotal
End If
End Sub
Private Sub Cuadricula_KeyPress(KeyAscii As Integer)
'If columna <> 5 Then Exit Sub
'If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub eliminar_Click()
Dim pregunta As String
pregunta = MsgBox("¿Desea elimar la factura?", vbYesNo, "Eliminar factura")
If pregunta = vbYes Then eliminar_factura
End Sub
Private Sub eliminar_factura()
If rsArtFactura.RecordCount > 0 Then
sql = "delete * from Articulos_Factura where Id_factura_Art= " & rsFactura("Id_factura")
With rsborrar
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'refrescamos los articulos y refrescamos la cuadricula, no se puede hacer con Refresh
rsArtFactura.Requery
End If
rsFactura.Delete
rsFactura.Requery
Unload Me
End Sub
Private Sub Id_Cliente_DblClick()
llamada = "Factura"
rsClientes.Filter = ""
List_Clientes.Show vbModal
datos_Cliente
End Sub
Private Sub imprimir_Click()
On Error GoTo Error
Dim sql
'guardamos los datos
guardarok = ""
guardar
If guardarok <> "si" Then Exit Sub
'comando sql con el que optenemos todos los datos
sql = "SELECT Numero_Factura.N_Factura, Numero_Factura.Id_Factura, Numero_Factura.Fecha, Numero_Factura.SubTotal, Numero_Factura.Cobrado, Numero_Factura.Resto, Numero_Factura.IVA, Numero_Factura.TotalIVa, Numero_Factura.Total, Numero_Factura.Observaciones, Articulos_Factura.Descuento, Articulos_Factura.Articulo, Articulos.Descripcion, Articulos_Factura.PVP, Articulos_Factura.Cantidad, Articulos_Factura.Descuento, Articulos_Factura.Total AS Total_Art, Clientes.Nombre, Clientes.Direccion, Clientes.CP, Clientes.Localidad, Clientes.Provincia, Clientes.NIF " _
& " FROM (Clientes INNER JOIN Numero_Factura ON Clientes.Id = Numero_Factura.Id_cliente) INNER JOIN (Articulos INNER JOIN Articulos_Factura ON Articulos.Codigo = Articulos_Factura.Articulo) ON Numero_Factura.Id_Factura = Articulos_Factura.Id_Factura_Art " _
& " where Numero_Factura.Id_factura=" & rsFactura("Id_Factura")
'abrimos el rs
With rsInforme
.Source = sql
.ActiveConnection = Conexion
.LockType = adLockOptimistic
.CursorType = adOpenStatic
.Open
End With
'aplicamos el rs al informe
Set factura_report.DataSource = rsInforme
'si no tiene articulos salimos de la impresión
If rsInforme.RecordCount = 0 Then
MsgBox "Factura sin datos", , "Impresión de factura"
rsInforme.Close
Exit Sub
End If
'asignamos los datos
With factura_report.Sections("Sección4")
.Controls("n_factura").Caption = rsInforme("N_Factura")
.Controls("nombre").Caption = rsInforme("Nombre")
.Controls("direccion").Caption = rsInforme("direccion")
.Controls("localidad").Caption = rsInforme("Localidad")
.Controls("provincia").Caption = rsInforme("Provincia")
'modificado por problemas en la impresion
'If rsInforme("CP") Or rsInforme("CP") <> Null Then .Controls("cp").Caption = rsInforme("CP")
'If rsInforme("NIF") <> "" Then .Controls("nif").Caption = rsInforme("NIF")
.Controls("cp").Caption = Factura.CP_Cliente
.Controls("nif").Caption = Factura.NIF_Cliente
.Controls("fecha").Caption = rsInforme("fecha")
End With
If Not IsNull(rsInforme("Observaciones")) Then factura_report.Sections("Sección5").Controls("comentario").Caption = rsInforme("Observaciones")
With factura_report.Sections("Sección3")
.Controls("subtotal").Caption = FormatNumber(rsInforme("SubTotal"), 2) & " "
.Controls("iva").Caption = rsInforme("IVA")
.Controls("totaliva").Caption = FormatNumber(rsInforme("TotalIva"), 2) & " "
.Controls("cobrado").Caption = FormatNumber(rsInforme("Cobrado"), 2) & " "
.Controls("resto").Caption = FormatNumber(rsInforme("Resto"), 2) & " "
.Controls("total").Caption = FormatNumber(rsInforme("Total"), 2) & " "
End With
'visualizamos el informe
factura_report.Show vbModal
rsInforme.Close
Exit Sub
Error:
MsgBox Err.Description
Resume Next
End Sub
Private Sub Cuadricula_AfterColUpdate(ByVal ColIndex As Integer)
'actualizar la cuadricula
actualizar_articulo
End Sub
Private Sub Cuadricula_ColEdit(ByVal ColIndex As Integer)
' almacenamos el articulo para saver si ha cambiado
If Not IsNull(rsArtFactura("Articulo")) And rsArtFactura.RecordCount > 0 Then
saveart = rsArtFactura("Articulo")
End If
End Sub
Private Sub fecha_DblClick()
calendario.Value = DateValue(Now)
calendario.Visible = True
End Sub
Private Sub fecha_KeyPress(KeyAscii As Integer)
' si pulsamos tecla Esc se esconde
If KeyAscii = 27 Then calendario.Visible = False
End Sub
Private Sub Form_Load()
'eliminar los filtros
rsArtFactura.Filter = ""
rsClientes.Filter = ""
If action = "nueva" Then
'crear una factura nueva
'pregunta:
'If Not rsFactura.RecordCount = 0 Then
'rsFactura.Requery
'rsFactura.MoveLast
'Id_factura = rsFactura("N_Factura") + 1
'Else
'Id_factura = InputBox("Ha de inicializar el número de factura", "Atención")
'End If
ClassIni.Bloque = "Numero"
Id_factura = ClassIni.Leer("Factura")
Id_factura.Enabled = False
'If Id_factura <> "" Then
datos_factura
fecha = DateValue(Now)
posicion_anterior = 0
'Else
'GoTo pregunta
'End If
Else
'buscar factura
If action = "buscar" Then
Id_factura = numero
datos_factura
fecha = rsFactura("Fecha")
'Total_Suma = rsFactura("SubTotal")
'resto = rsFactura("Resto")
cobrado = rsFactura("Cobrado")
'iva = rsFactura("iva")
'total_factura = rsFactura("Total")
'total_iva = rsFactura("TotalIva")
SumaTotal
Id_factura.Enabled = False
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
rsArtFactura.Filter = ""
rsFactura.Filter = ""
rsClientes.Filter = ""
'Principal.Enabled = True
End Sub
Private Sub datos_Cliente()
'Mostrar los datos del cliente
If Id_Cliente <> "" Then
rsClientes.Filter = "Id= " & Id_Cliente
'y comprovamos que el número exista
If rsClientes.RecordCount > 0 Then
Nombre_Cliente = rsClientes("Nombre")
Direccion_Cliente = rsClientes("Direccion")
'si el codigo postal no existe da error, pero lo controlamos
If Not IsNull(rsClientes("CP")) Then
CP_Cliente = rsClientes("CP")
Else
CP_Cliente = ""
End If
Localidad_Cliente = rsClientes("Localidad")
Provincia_Cliente = rsClientes("Provincia")
If Not IsNull(rsClientes("NIF")) Then
NIF_Cliente = rsClientes("NIF")
Else
NIF_Cliente = ""
End If
'controlar que el telefono no es nulo
If Not IsNull(rsClientes("Telefono_Fijo")) Then
Telefono_Cliente = rsClientes("Telefono_Fijo")
Else
Telefono_Cliente = ""
End If
Else
MsgBox "No existe el cliente", , "¡¡Atención!!"
End If
Else
'si no existe el cliente borramos los campos de dato de cliente
Nombre_Cliente = ""
Direccion_Cliente = ""
CP_Cliente = ""
Localidad_Cliente = ""
Provincia_Cliente = ""
NIF_Cliente = ""
Telefono_Cliente = ""
End If
End Sub
Private Sub Id_Cliente_Validate(Cancel As Boolean)
'Actualizar el cliente
datos_Cliente
End Sub
Private Sub datos_factura()
Dim sql
If action = "nueva" Then
rsFactura.AddNew
rsFactura("N_Factura") = Id_factura
rsFactura.Update
rsFactura.Requery
rsFactura.MoveLast
'filtramos los articulos, para que no salga niguno que no pertenecca a la factura actual
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
Cuadricula.Enabled = True
Set rs = rsArtFactura
Set Cuadricula.DataSource = rsArtFactura
Cuadricula.ReBind
With Cuadricula
'titulo que aparece en la cuadricula
.Caption = "Artículos Facturados"
End With
Else
If action = "buscar" Then
'cerramos y abrimos rsFactura con el número de factura que buscamos
Id_Cliente = rsFactura("Id_Cliente")
datos_Cliente
rsArtFactura.Filter = "Id_Factura_Art= " & rsFactura("Id_Factura")
If rsFactura("observaciones") <> "" Then SubFactura_texto = rsFactura("Observaciones")
Cuadricula.Enabled = True
Set rs = rsArtFactura
Set Cuadricula.DataSource = rsArtFactura
Cuadricula.ReBind
With Cuadricula
'titulo que aparece en la cuadricula
.Caption = "Artículos Facturados"
End With
If Not IsNull(rsFactura("N_Presupuesto")) Then n_pre = rsFactura("N_presupuesto")
End If
End If
End Sub
Private Sub Id_factura_Validate(Cancel As Boolean)
'cuando tenemos número de factura fitramos los articulos y activamos la cuadricula
datos_factura
End Sub
Private Sub iva_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
End Sub
Private Sub iva_Validate(Cancel As Boolean)
'recalculo del total
SumaTotal
End Sub
Private Sub mostrar_art_Click()
saveart = ""
Error = "si"
llamada = "Factura"
List_Articulos.Show vbModal
If Error = "no" Then
actualizar_articulo
total
SumaTotal
End If
End Sub
Private Sub nuevo_cliente_Click()
Cliente.Show vbModal
End Sub
Private Sub salir_Click()
Dim respuesta
If action = "nueva" Then
respuesta = MsgBox("¿Desea grabar los datos de la factura?", vbYesNoCancel, "¡¡Atención!!")
Else: respuesta = vbYes
End If
'en caso de querer grabar comprobamos que estén todos los datos
'garbamos el total sin sumarle el iva
If respuesta = vbYes Then
guardar
If guardarok = "si" Then
If action = "nueva" Then
ClassIni.Bloque = "Numero"
Call ClassIni.Escribir("Factura", ClassIni.Leer("Factura") + 1)
End If
Unload Factura
End If
Exit Sub
'si cancelamos, volvemos a la factura
ElseIf respuesta = vbCancel Then
Exit Sub
End If
'si no, salimos sin grabar
If action = "nueva" Then eliminar_factura
Unload Factura
End Sub
Private Sub guardar()
On Error GoTo error_guardar
Dim cantidad As Double
If Id_factura <> "" And Id_Cliente <> "" Then
'resto = total_factura - cobrado
rsFactura("N_Factura") = Id_factura
rsFactura("Id_cliente") = Id_Cliente
cantidad = cobrado
rsFactura("Cobrado") = cantidad
cantidad = resto
rsFactura("Resto") = cantidad
cantidad = Total_Suma
rsFactura("SubTotal") = cantidad
cantidad = iva
rsFactura("iva") = cantidad
cantidad = total_factura
rsFactura("Total") = cantidad
cantidad = total_iva
rsFactura("TotalIva") = cantidad
rsFactura("Fecha") = fecha
rsFactura("Tipo_Factura") = "Factura"
If Not SubFactura_texto = "" Then rsFactura("Observaciones") = SubFactura_texto
rsFactura.Update
guardarok = "si"
Exit Sub
Else
'si falta algun dato cancelamos la operación
MsgBox "Ha de rellenar todos los datos", , "¡¡Atención!!"
guardarok = "no"
Exit Sub
End If
Exit Sub
error_guardar:
MsgBox Err.Description, , "Error al guadar"
Resume Next
End Sub
Private Sub sobre_Click()
If Nombre_Cliente = "" Then Exit Sub
Set Sobre_report.DataSource = rsClientes
With Sobre_report.Sections("Sección2")
.Controls("Etiqueta1").Caption = Nombre_Cliente
.Controls("Etiqueta2").Caption = Direccion_Cliente
.Controls("Etiqueta3").Caption = CP_Cliente & " " & Localidad_Cliente
.Controls("Etiqueta4").Caption = "(" & Provincia_Cliente & ")"
End With
Sobre_report.Show vbModal
End Sub