Dim CN As New Connection

Dim TP As New Recordset

 

 

Private Sub Form_Load()

CN.Provider = "Microsoft.Jet.OLEDB.4.0"

CN.ConnectionString = "Data Source=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

TP.LockType = adLockOptimistic

TP.Open "Personal", CN

End Sub

 

Private Sub Command1_Click()

TP.MoveFirst

TP.Find "Codigo = '" & Text1 & "'"

If Not TP.EOF Then

    MsgBox "Codigo Repetido", 16

    Exit Sub

End If

TP.AddNew

TP!Codigo = Text1

TP!Nombre = Text2

TP!Sueldo = Val(Text3)

TP.Update

Command2_Click

End Sub

 

Private Sub Command2_Click()

Text1 = ""

Text2 = ""

Text3 = ""

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

TP.Close

CN.Close

Unload Me

End Sub

 

 

 

 

 

 

 

Dim CN As New Connection

Dim TP As New Recordset

Dim SQL As String

 

Private Sub Form_Load()

CN.Provider = "Microsoft.Jet.OLEDB.4.0"

CN.ConnectionString = "Data Source=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

End Sub

 

Private Sub Command1_Click()

SQL = "Select * from Personal where codigo = '" & Text1 & "'"

Set TP = CN.Execute(SQL)

If TP.EOF Then

    MsgBox "Codigo No Existe", 16

    Exit Sub

End If

Label4 = TP!Nombre

Label5 = TP!Sueldo

End Sub

 

Private Sub Command2_Click()

Text1 = ""

Label4 = ""

Label5 = ""

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

CN.Close

Unload Me

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Dim CN As New Connection

Dim TP As New Recordset

 

Private Sub Form_Load()

CN.Provider = "Microsoft.Jet.OLEDB.4.0"

CN.ConnectionString = "Data Source=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

TP.LockType = adLockOptimistic

TP.Open "Personal", CN

End Sub

 

Private Sub Command1_Click()

TP.MoveFirst

TP.Find "Codigo = '" & Text1 & "'"

If TP.EOF Then

    MsgBox "Codigo No Existe", 16

    Exit Sub

End If

Text2 = TP!Nombre

Text3 = TP!Sueldo

End Sub

 

Private Sub Command2_Click()

TP!Nombre = Text2

TP!Sueldo = Val(Text3)

TP.Update

End Sub

 

Private Sub Command3_Click()

Text1 = ""

Text2 = ""

Text3 = ""

Text1.SetFocus

End Sub

 

Private Sub Command4_Click()

TP.Close

CN.Close

Unload Me

End Sub

 

 

 

 

 

 

Dim CN As New Connection

Dim TP As New Recordset

Dim SQL As String

 

Private Sub Form_Load()

CN.Provider = "Microsoft.Jet.OLEDB.4.0"

CN.ConnectionString = "Data Source=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

End Sub

 

Private Sub Command1_Click()

SQL = "Select * from Personal where codigo = '" & Text1 & "'"

Set TP = CN.Execute(SQL)

If TP.EOF Then

    MsgBox "Codigo No Existe", 16

    Exit Sub

End If

Label4 = TP!Nombre

Label5 = TP!Sueldo

End Sub

 

Private Sub Command2_Click()

SQL = "DELETE FROM PERSONAL WHERE CODIGO = '" & Text1 & "'"

Set TP = CN.Execute(SQL)

Command3_Click

End Sub

 

Private Sub Command3_Click()

Text1 = ""

Label4 = ""

Label5 = ""

Text1.SetFocus

End Sub

 

Private Sub Command4_Click()

CN.Close

Unload Me

End Sub

 

 

 

 

 

 

 

 

Dim CN As New CONNECTION

Dim TP As New Recordset

Dim F As Long

 

Private Sub Command1_Click()

TP.Close

CN.Close

Unload Me

End Sub

 

Private Sub Form_Load()

CN.Provider = "MICROSOFT.JET.OLEDB.4.0"

CN.ConnectionString = "DATA SOURCE=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

 

TP.LockType = adLockOptimistic

TP.Open "Personal", CN

TP.MoveLast

FG1.Rows = TP.RecordCount + 1

TP.MoveFirst

 

FG1.Cols = 5

FG1.ColWidth(0) = 700

FG1.ColWidth(1) = 3000

FG1.ColWidth(2) = 3000

FG1.ColWidth(3) = 1100

FG1.ColWidth(4) = 1000

 

FG1.TextMatrix(0, 0) = "Codigo"

FG1.TextMatrix(0, 1) = "Nombre"

FG1.TextMatrix(0, 2) = "Direccion"

FG1.TextMatrix(0, 3) = "Telefono"

FG1.TextMatrix(0, 4) = "Sueldo"

 

F = 0

Do While Not TP.EOF

    F = F + 1

    FG1.TextMatrix(F, 0) = TP!codigo

    FG1.TextMatrix(F, 1) = TP!NOMBRE

    FG1.TextMatrix(F, 2) = TP!DIRECCION

    FG1.TextMatrix(F, 3) = TP!TELEFONO

    FG1.TextMatrix(F, 4) = TP!SUELDO

    TP.movenext

Loop

End Sub

 

Dim CN As New Connection

Dim TP As New Recordset

Dim SQL As String

 

Private Sub presenta()

Text1 = TP!codigo

Text2 = TP!Nombre

Text3 = TP!Sueldo

End Sub

 

Private Sub Command1_Click()

TP.MoveFirst

presenta

End Sub

 

Private Sub Command2_Click()

On Error GoTo a

TP.MovePrevious

presenta

Exit Sub

a:

MsgBox "Inicio del Archivo", vbInformation

TP.MoveNext

End Sub

 

Private Sub Command3_Click()

On Error GoTo a

TP.MoveNext

presenta

Exit Sub

a:

MsgBox "Fin del Archivo", vbInformation

TP.MovePrevious

End Sub

 

Private Sub Command4_Click()

TP.MoveLast

presenta

End Sub

 

Private Sub Form_Load()

CN.Provider = "Microsoft.Jet.OLEDB.4.0"

CN.ConnectionString = "Data Source=" & App.Path & "Empresa.mdb"

CN.CursorLocation = adUseClient

CN.Open

TP.Open "Personal", CN

presenta

End Sub

 

Dim cn As New Connection

Dim tp As New Recordset

Dim sql As String

 

Private Sub Command1_Click()

sql = "select*from personal where codigo ='" & Text1 & "'"

Set tp = cn.Execute(sql)

If tp.EOF Then

MsgBox "codigo no Existe", 16

Text1 = "": Text1.SetFocus

Exit Sub

End If

Label6 = tp!Nombre

Label7 = tp!Direccion

Label8 = tp!Telefono

Label9 = tp!Sueldo

Image1.Picture = LoadPicture(App.Path & "fotos" & Text1 & ".jpg")

End Sub

 

Private Sub Command2_Click()

Text1 = ""

Label6 = ""

Label7 = ""

Label8 = ""

Label9 = ""

Image1.Picture = LoadPicture()

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

cn.Close

Unload Me

End Sub

 

Private Sub Form_Load()

cn.Provider = "microsoft.jet.oledb.4.0"

cn.ConnectionString = "data source=" & App.Path & "Empresa.mdb"

cn.CursorLocation = adUseClient

cn.Open

End Sub

Como llenar un DataGrid
SQL = "SELECT * FROM Clientes Where Nombre Like 'A%'"
RS.Open SQL, CN
Set DataGrid1.DataSource = RS
DataGrid1.Refresh

 

Private Sub msflexgrid1_DblClick()

With MSFlexGrid1

Form2.Text1 = .TextMatrix(.Row, 0)

Form2.Label4 = .TextMatrix(.Row, 1)

Form2.Label5 = .TextMatrix(.Row, 2)

Form6.Hide

End With

End Sub

 

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    TP.MoveFirst

    TP.Find "Codigo = '" & Text1 & "'"

    If Not TP.EOF Or Text1 = "" Then

      MsgBox "Codigo Repetido", 16

        Exit Sub

    End If

Text2.SetFocus

End If

End Sub

 

Private Sub Text2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If Text2 = "" Then

        MsgBox "Falta Nombre", 16

        Text2.SetFocus

        Exit Sub

    End If

Text3.SetFocus

End If

 

Private Sub Text3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If Val(Text3) < 0 Then

        MsgBox "INgrese el sueldo", 16: Text3.SetFocus: Exit Sub

    End If

    TP.AddNew

    TP!codigo = Text1

    TP!nombre = Text2

    TP!sueldo = Val(Text3)

    TP.Update

    Data1.RecordSource = "Select * from personal order by codigo"

    Data1.Refresh

    limpiar

   

End If

End Sub

 

Private Sub Text3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If Val(Text3) < 0 Then

        MsgBox "INgrese el sueldo", 16: Text3.SetFocus: Exit Sub

    End If

    TP.AddNew

    TP!codigo = Text1

    TP!nombre = Text2

    TP!sueldo = Val(Text3)

    TP.Update

    Data1.Refresh

    limpiar

   

End If

End Sub

Programa a Trabajar 
Private Sub Command1_Click()
If Trim(Text1) = "" Then
    MsgBox "Ingrese el nombre de la ciudad", vbInformation
    Text1.SetFocus
    Exit Sub
End If
    OrdenSQL = "insert into ciudades values ('" & Label2 & "','" & Text1 & "')"
    Set rs1 = Conexion.Execute(OrdenSQL)
    Call presenta("ciudades", DataGrid1)
    Label2 = GeneraCodigo("Ciudades", "Codigo")
    Label2 = FormatoCodigo(Label2, 4)
    Text1 = Clear
    Text1.SetFocus
End Sub

Private Sub Command3_Click()
If Trim(Text1) = "" Then
    MsgBox "Ingrese el nombre de la ciudad", 16
    Text1.SetFocus
    Exit Sub
End If

OrdenSQL = "update ciudades set descripcion='" & Text1 & "' where codigo= '" & Trim(Label5) & "'"
Set rs1 = Conexion.Execute(OrdenSQL)

Call presenta("ciudades", DataGrid1)
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub DataGrid1_Click()
Label5 = DataGrid1.Columns(0).Text
Text1 = DataGrid1.Columns(1).Text
End Sub

Private Sub DataGrid1_DblClick()
On Error GoTo final
Dim op As Integer
  op = MsgBox("¿Está seguro de eliminar el registro de la base?", vbYesNo + vbInformation)
  If op = vbNo Then
     Exit Sub
  End If
  '-----------------------------------
  OrdenSQL = "Delete from ciudades where Codigo='" & DataGrid1.Columns(0).Text & "'"
  Set rs1 = Conexion.Execute(OrdenSQL)
   
  Call presenta("ciudades", DataGrid1)
  'Label3 = GeneraCodigo("ciudades", "Codigo")
  'Label3 = FormatoCodigo(Label3, 4)
  Exit Sub
final:
    MsgBox "El Registro no puede ser eliminado porque contiene datos relacionados", 16
  
End Sub

Private Sub Form_Load()
Call AbreBD
Label2 = GeneraCodigo("Ciudades", "Codigo")
Label2 = FormatoCodigo(Label2, 4)
Call presenta("ciudades", DataGrid1)
End Sub

'crea procedimientos para presentar los datos
'Public Sub presenta()
 '  OrdenSQL = "select * from Ciudades"
 '  Set rs1 = Conexion.Execute(OrdenSQL)
 '  Set DataGrid1.DataSource = rs1
'End Sub


Modulo
Public Conexion As ADODB.Connection
Public rs1 As ADODB.Recordset

Public Cod As ADODB.Recordset

Public OrdenSQL As String

Public Sub AbreBD()
  'abre la base y la enlaza
  Set Conexion = New ADODB.Connection
 
  Conexion.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
  & App.Path & "Clientes.mdb ;Jet OLEDB:Database1<S"
 
  Conexion.CursorLocation = adUseClient
End Sub

Public Function GeneraCodigo(tabla As String, CampoCodigo As String) As String
 'genera codigo de cualquier programa
 On Error GoTo s
 OrdenSQL = "Select max(" & CampoCodigo & ") as Maximo from " & tabla
 Set Cod = Conexion.Execute(OrdenSQL)
 GeneraCodigo = Val(Cod!Maximo) + 1
 Exit Function
s:
    GeneraCodigo = "1"
End Function

Public Function FormatoCodigo(Cod_Formatear As String, Longitud As Integer) As String
   'le da formato a el codigo
   Dim L As Integer
   L = Len(Cod_Formatear)
   For x = 1 To Longitud - L
     FormatoCodigo = FormatoCodigo + "0"
   Next x
     FormatoCodigo = FormatoCodigo + Cod_Formatear
End Function

Public Sub presenta(tabla As String, datag As Object)
OrdenSQL = "select * from " + tabla
Set rs1 = Conexion.Execute(OrdenSQL)
Set datag.DataSource = rs1
End Sub

'para utilizar este preocedimiento es estudiante debera hacer creado
'una tabla que contenga dos campos, cuyos nombres sean:
'codigo y descripcion .....
Public Sub cargarcombo(tabla As String, combo As Object)
OrdenSQL = "select * from " + tabla
Set rs1 = Conexion.Execute(OrdenSQL)
With rs1
    If Not .BOF Then
        .MoveFirst
    End If
    Do While Not .EOF
        combo.AddItem !codigo + "-" + !descripcion
        .MoveNext
    Loop
        combo.ListIndex = 0
End With
End Sub

Ejercicios de Facturacion con tablas relacionadas
 Dim CN As New Connection
Dim TC As New Recordset
Dim TA As New Recordset
Dim TF As New Recordset
Dim TD As New Recordset

Dim F, C, NF, X As Long
Dim T, ST, IVA, VP As Single

Private Sub Command1_Click()
TF.AddNew
TF!NFac = NF
TF!Fecha = Date
TF!Cod_Cli = Text1
TF.Update

For X = 1 To F
    TD.AddNew
    TD!NFac = NF
    TD!Cod_Art = FG1.TextMatrix(X, 0)
    TD!Cantidad = Val(FG1.TextMatrix(X, 2))
    TD.Update
   
    TA.MoveFirst
    TA.Find "Codigo='" & TD!Cod_Art & "'"
    TA!Existencia = TA!Existencia - TD!Cantidad
    TA.Update
Next X

Command2_Click

TF.MoveLast
NF = TF!NFac + 1
Label2 = Format(NF, "00000")
End Sub

Private Sub Command2_Click()
Text1 = ""
Label7 = ""
Text2 = ""
Label8 = ""
Text3 = ""
Label9 = ""
For X = 1 To 49
    FG1.TextMatrix(X, 0) = ""
    FG1.TextMatrix(X, 1) = ""
    FG1.TextMatrix(X, 2) = ""
    FG1.TextMatrix(X, 3) = ""
    FG1.TextMatrix(X, 4) = ""
Next X
Label13 = ""
Label14 = ""
Label15 = ""
Text1.SetFocus
Text2.Enabled = False
Text3.Enabled = False
Command1.Enabled = False
F = 0
ST = 0
End Sub

Private Sub Command3_Click()
TC.Close
TA.Close
TF.Close
TD.Close
CN.Close
Unload Me
End Sub

Private Sub Form_Load()
CN.Provider = "MICROSOFT.JET.OLEDB.4.0"
CN.ConnectionString = "DATA SOURCE=" & App.Path & "NEGOCIO.MDB"
CN.CursorLocation = adUseClient
CN.Open

TC.LockType = adLockOptimistic
TC.Open "CLIENTES", CN
TA.LockType = adLockOptimistic
TA.Open "ARTICULOS", CN
TF.LockType = adLockOptimistic
TF.Open "FACTURAS", CN
TD.LockType = adLockOptimistic
TD.Open "DETALLES", CN

FG1.Cols = 5
FG1.Rows = 50
FG1.FixedCols = 0
FG1.ColWidth(0) = 700
FG1.ColWidth(1) = 3000
FG1.ColWidth(2) = 1000
FG1.ColWidth(3) = 1000
FG1.ColWidth(4) = 1000
FG1.TextMatrix(0, 0) = "CODIGO"
FG1.TextMatrix(0, 1) = "DESCRIPCION"
FG1.TextMatrix(0, 2) = "CANTIDAD"
FG1.TextMatrix(0, 3) = "PRECIO"
FG1.TextMatrix(0, 4) = "TOTAL"

TF.MoveLast
NF = TF!NFac + 1
Label2 = Format(NF, "00000")
Label4 = Date

Text2.Enabled = False
Text3.Enabled = False
Command1.Enabled = False

ST = 0
F = 0
End Sub

 

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    TC.MoveFirst
    TC.Find "Codigo='" & Text1 & "'"
    If TC.EOF Then
        MsgBox "Cliente No Existe !!!", 16
        Text1 = ""
        Text1.SetFocus
        Exit Sub
    End If
    Label7 = TC!Nombre
    Text2.Enabled = True
    Text2.SetFocus
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    TA.MoveFirst
    TA.Find "Codigo='" & Text2 & "'"
    If TA.EOF Then
        MsgBox "Articulo No Existe !!!", 16
        Text2 = ""
        Text2.SetFocus
        Exit Sub
    End If
    Label8 = TA!Descripcion
    Label9 = TA!precio
    Text3.Enabled = True
    Text3.SetFocus
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    C = Val(Text3)
    If C > TA!Existencia Then
        MsgBox "Excede Existencia", 16
        Text3 = ""
        Text3.SetFocus
        Exit Sub
    End If
    F = F + 1
    FG1.TextMatrix(F, 0) = Text2
    FG1.TextMatrix(F, 1) = Label8
    FG1.TextMatrix(F, 2) = Text3
    FG1.TextMatrix(F, 3) = FormatCurrency(Label9)
    T = TA!precio * C
    FG1.TextMatrix(F, 4) = FormatCurrency(T)
    ST = ST + T
    IVA = ST * 0.12
    VP = ST + IVA
    Label13 = FormatCurrency(ST)
    Label14 = FormatCurrency(IVA)
    Label15 = FormatCurrency(VP)
    Text2 = ""
    Label8 = ""
    Text3 = ""
    Label9 = ""
    Text2.SetFocus
    Command1.Enabled = True
End If
End Sub
 

Programa de Consulta Global con Modificacion

Dim cn As New Connection
Dim tp As New Recordset
Dim f As Long

Private Sub Command1_Click()
tp!nombre = Text1
tp!direccion = Text2
tp!telefono = Text3
tp.MoveFirst
f = 0
Do While Not tp.EOF
   
    f = f + 1
   
fg1.TextMatrix(f, 0) = tp!codigo
fg1.TextMatrix(f, 1) = tp!nombre
fg1.TextMatrix(f, 2) = tp!direccion
fg1.TextMatrix(f, 3) = tp!telefono
fg1.TextMatrix(f, 4) = tp!sueldo
tp.MoveNext

Loop

End Sub

Private Sub Command2_Click()
tp.Close
cn.Close
Unload Me
End Sub

Private Sub fg1_DblClick()
fg1.Col = 0
tp.MoveFirst
tp.Find "codigo= '" & fg1.Text & "'"
Label6 = tp!codigo
Text1 = tp!nombre
Text2 = tp!direccion
Text3 = tp!telefono
Text4 = tp!sueldo
End Sub

Private Sub Form_Load()
cn.Provider = "microsoft.ace.oledb.12.0"
cn.ConnectionString = App.Path & "empresas.accdb"
cn.CursorLocation = adUseClient
cn.Open
tp.LockType = adLockOptimistic
tp.Open "personal", cn
tp.MoveLast
fg1.Rows = tp.RecordCount + 1
tp.MoveFirst
fg1.Cols = 5
fg1.FixedCols = 0

fg1.ColWidth(0) = 700
fg1.ColWidth(1) = 3800
fg1.ColWidth(2) = 3000
fg1.ColWidth(3) = 1100
fg1.ColWidth(4) = 1000

fg1.TextMatrix(0, 0) = tp!codigo
fg1.TextMatrix(0, 1) = tp!nombre
fg1.TextMatrix(0, 2) = tp!direccion
fg1.TextMatrix(0, 3) = tp!telefono
fg1.TextMatrix(0, 4) = tp!sueldo

f = 0

Do While Not tp.EOF
   
    f = f + 1
   
fg1.TextMatrix(f, 0) = tp!codigo
fg1.TextMatrix(f, 1) = tp!nombre
fg1.TextMatrix(f, 2) = tp!direccion
fg1.TextMatrix(f, 3) = tp!telefono
fg1.TextMatrix(f, 4) = tp!sueldo
tp.MoveNext

Loop

End Sub