Visual Basic - filtrar datos de un datagrid y al hacer doble click pasarlos a otro formulario

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil

filtrar datos de un datagrid y al hacer doble click pasarlos a otro formulario

Publicado por Agos (3 intervenciones) el 15/04/2016 22:33:35
Hola a todos!!!
Estoy haciendo un programa en visual basic 6 y trabajando con una base de datos access.
quiero hacer un datagrid filtrando por nro de contrato y al hacer doble click quiero que me copie los datos seleccionados en un nuevo formulario.
Me podrian encaminar con algun codigo?? Gracias

algo habia hecho pero me salta error en muchos lados

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
Public DatGridVacio As Boolean
Private Sub Form_Load()
Call conexion
Dim base As New ADODB.Recordset
 
If Editar = 1 Then
  Label1.Caption = "EDITAR SERVICIO"
  base.CursorLocation = adUseClient
   If base.State = 1 Then base.Close
   Set base = New ADODB.Recordset
   base.Open "Select * from CONTRATOS", a, adOpenKeyset, adLockOptimistic
   Set DataGrid1.DataSource = base
ElseIf InformarPago = 1 Then
  Label1.Caption = "INFORMAR PAGO"
  base.CursorLocation = adUseClient
  If base.State = 1 Then base.Close
  Set base = New ADODB.Recordset
  base.Open "Select *from CONTRATOS WHERE NRO_CONTRATO", a, adOpenKeyset, adLockReadOnly
  Set DataGrid1.DataSource = base
ElseIf VerPagos = 1 Then
  Label1.Caption = "VER PAGOS"
  OptionDNI.Visible = False
  base.CursorLocation = adUseClient
  If base.State = 1 Then base.Close
  Set base = New ADODB.Recordset
  base.Open "Selecr * from PAGOS", a, adOpenKeyset, adLockReadOnly
  Set DatGrID1.DataSource = base
End If
End Sub
 
Private Sub OptionDNI_Click()
Text1.Text = ""
If Text1.Visible = True Then
  Text1.SetFocus
End If
  Call Text1_Change
End Sub
 
Private Sub OptionContrato_Click()
Text1.Text = ""
If Text1.Visible = True Then
  Text1.SetFocus
End If
  Call Text1_Change
End Sub
 
Private Sub Text1_Change()
Dim NroContratoBuscado As String
Dim DNIBuscado As String
 
NroContratoBuscado = ""
DNIBuscado = ""
 
If Text1.Text = "" Then
  If InformarPago = 1 Then
     base.Open "Select * from CONTRATOS WHERE NRO_CONTRATO", a, adOpenDynamic, adLockOptimistic
     Set DataGrid1.DataSource = base
     Set base = Nothing
     Exit Sub
  ElseIf VerPagos = 1 Then
     base.Open "Select * from PAGOS", a, adOpenDynamic, adLockOptimistic
     Set DataGrid1.DataSource = base
     Set base = Nothing
     Exit Sub
  Else
  base.Open "Select * from CONTRATOS", a, adOpenKeyset, adLockOptimistic
  Set DataGrid1.DataSource = base
  Set base = Nothing
  End If
Else
If OptionContrato.Value = True Then
NroContratoBuscado = Text1.Text
  If VerPagos <> 1 Then
     If InformarPago <> 1 Then
        base.Open "Select * from CONTRATOS WHERE NRO_CONTRATO LIKE '" & NroContratoBuscado & "%';", a, adOpenDynamic, adLockOptimistic
        Set DataGrid1.DataSource = base
        Set base = Nothing
     End If
  End If
  If VerPago = 1 Then
  base.Open "select *from PAGOS WHERE NRO_CONTRATO LIKE '" & NroContratoBuscado & "%';", a, adOpenDynamic, adLockOptimistic
  Set DataGrid1.DataSource = base
  Set base = Nothing
  Exit Sub
  End If
ElseIf OptionDNI.Value = True Then
    If Text1.Text = "" Then
       base.Open "select * from CONTRATOS", a, adOpenKeyset, adLockOptimistic
       Set DataGrid1.DataSource = base
       Set base = Nothing
       Exit Sub
   End If
DNIBuscado = Text1.Text
   If InformarPago = 1 Then
      base.Open "Select * from CONTRATOS WHERE DNI_SOCIO LIKE '" & DNIBuscado & "%' AND NRO_CONTRATO", a, adOpenDynamic, adLockOptimistic
      Set DataGrid1.DataSource = base
      Set base = Nothing
      Exit Sub
   End If
base.Open "Select * from CONTRATOS WHERE DNI_SOCIO LIKE '" & DNIBuscado & "%';", a, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = base
Set base = Nothing
Else
End If
End If
End Sub
 
Private Sub Text1_KeyPress(keyascii As Integer)
  If OptionDNI.Value = True Then
   Select Case keyascii
          Case 46, 8, 48 To 57
        Case Else
          keyascii = 0
          Beep
   End Select
  ElseIf OptionContrato.Value = True Then
   Select Case keyascii
          Case 8
          Case 47 To 57
        Case Else
          keyascii = 0
          Beep
   End Select
  End If
End Sub
 
Private Sub CmdVolverInicio_Click()
If base.State = 1 Then base.Close
Set base = Nothing
Set a = Nothing
Inicio.Show
TodoCero
Unload Me
End Sub
 
Private Sub DataGrid1_DblClick()
 DataGridVacio = False
 
If Editar = 1 Then
   Call tranf_dato
   Set base = Nothing
  If DataGridVacio = False Then
     EditarServicio.Show 0
     Unload Me
  Else
    MsgBox "No hay socios cargados", vbOKOnly, "ATENCIÓN"
  End If
 
ElseIf InformarPago = 1 Then
   Call tranf_dato
   Set base = Nothing
  If DataGrid1.ApproxCount = 0 Then
  MsgBox "No hay socios cargados", vbOKOnly, "ATENCIÓN"
  End If
 
  If InformarPago <> 1 Then
  If DataGridVacio = False Then
     DetallePago.Show 0
     Unload Me
  Else
     MsgBox "No hay socios cargados", vbOKOnly, "ATENCIÓN"
  End If
  End If
 
ElseIf VerPagos = 1 Then
   Call tranf_dato
   Set base = Nothing
  If DataGridVacio = False Then
     DetallePago.Show 0
     Unload Me
  Else
     MsgBox "No hay pagos cargados", vbOKOnly, "ATENCIÓN"
  End If
End If
End Sub
 
Function tranf_dato()
Dim base As New ADODB.Recordset
 Dim NumContrato2 As String
 Dim NumContratoBuscado As String
 Dim DNI2 As Long
 Dim IdServicio2 As String
 Dim SituacionConexion2 As String
 Dim NumFactura2 As String
 Dim MesAbonado2 As String
 'Dim MesAbonado2 As String
 Dim FechaPago2 As Date
 Dim Importe2 As Integer
 
 NumContrato2 = 0
 DNI2 = 0
 IDServicio = 0
 SituacionConexion2 = ""
 NumFactura2 = ""
 MesAbonado2 = ""
 FechaPago2 = 1 / 1 / 1753
 Importe2 = 0
 
 NumContratoBuscado = ""
 
 If DataGrid1.ApproxCount = 0 Then DataGridVacio = True
   If DataGrid1.ApproxCount = 0 Then Exit Function
      If VerPagos = 1 And InformarPago = 1 Then
         DataGrid1.Refresh
         NumContrato2 = DataGrid1.Columns(0)
         NumFactura2 = DataGrid1.Columns(1)
         MesAbonado2 = DataGrid1.Columns(4)
         FechaPago2 = DataGrid1.Columns(2)
         Importe2 = DataGrid1.Columns(3)
      End If
  base.Open "Select * from CONTRATOS WHERE NRO_CONTRATO LIKE '" & NumContrato2 & "% ';", a, adOpenDynamic, adLockOptimistic
  Set DataGrid1.DataSource = base
  DataGrid1.Refresh
  Set base = Nothing
 
 
 NumContrato2 = DataGrid1.Columns(0)
   If Editar = 1 Then
      DNI2 = DataGrid1.Columns(1)
      IdServicio2 = DataGrid1.Columns(3)
      SituacionConexion2 = DataGrid1.Columns(2)
   End If
 
   If InformarPago = 1 Then
   NumContrato = NumContrato2
   Importe = Importe2
   Set base = Nothing
   Set a = Nothing
   Unload Me
   DetallePago.Show 0
   End If
    DataGrid1.Refresh
    Set base = Nothing
 
  If VerPagos = 0 And InformarPago = 0 Then
   base.Open "Select max(FECHA_PAGO) FROM PAGOS WHERE NUM_CONTRATO LIKE '" & NumContratoBuscado & "% '; ", a, adOpenDynamic, adLockOptimistic
   Set DataGrid1.DataSource = base
   If DataGrid1.Columns(0) <> "" Then
   UltFechaPago = DataGrid1.Columns(0)
   DataGrid1.Refresh
   Set base = Nothing
   base.Open "select * from PAGOS WHERE NUM_CONTRATO LIKE '" & NumContratoBuscado & "%' AND FECHA_PAGO LIKE '" & UltFechaPago & "';", a, adOpenDynamic, adLockOptimistic
 
   Set DataGrid1.DataSource = base
     DataGrid1.Refresh
   Set base = Nothing
 
   If DataGrid1.ApproxCount = 1 Then
     FechaPago2 = DataGrid1.Columns(2)
     MesAbonado2 = DataGrid1.Columns(4)
     Importe2 = DataGrid1.Columns(3)
 
     With DetallePago
      .TxtFechaPago = UltFechaPago
      .TxtFechaPago = FechaPago2
      .Combo1 = MesAbonado2
      .TxtNroFactura = NumFactura2
     End With
    ElseIf DataGrid1.ApproxCount > 1 Then
    End If
  If Baja <> 1 Then
  With EditarServicio
  .TxtNumContrato = NumContrato2
End With
End If
Unload Me
End If
End If
 
End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder