Tengo el Siguiente codigo:
ption Explicit
Dim mostar_adv As Boolean
'Permite Ocultar todos los frames para mostrar solo las
'opciones que el usuario ha seleccionado
Private Sub oculta_frames()
Dim i As Integer
For i = 0 To pbx_opc.UBound
pbx_opc(i).Visible = False
pbx_opc(i).BorderStyle = 0
Next i
pbx_principal.Visible = False
pbx_principal.BorderStyle = 0
Pic_rep_2007.Visible = False
Pic_rep_2007.BorderStyle = 0
End Sub
'ubica el frame en la posición correcta.
'segun la selección del usuario
Private Sub muestra_opciones(indice As Integer)
If indice = 2 And an_o_actual > 2006 Then
Pic_rep_2007.Visible = True
Pic_rep_2007.Top = lbl_titulo.Top + lbl_subtitulo.Height + lbl_titulo.Height
Pic_rep_2007.Left = 660 + 2895 + 200
Pic_rep_2007.Top = lbl_titulo.Top + lbl_subtitulo.Height + lbl_titulo.Height
Pic_rep_2007.Left = 660 + 2895 + 200
Else
pbx_opc(indice).Visible = True
pbx_opc(indice).Top = lbl_titulo.Top + lbl_subtitulo.Height + lbl_titulo.Height
pbx_opc(indice).Left = 660 + 2895 + 200
pbx_principal.Top = lbl_titulo.Top + lbl_subtitulo.Height + lbl_titulo.Height
pbx_principal.Left = 660 + 2895 + 200
End If
End Sub
Private Sub Command2_Click()
Dim obj_causado As New Gastos_causados
Dim total_debe As Double
Dim total_haber As Double
Call obj_causado.Suma_causados_por_partida_proy("4.01.0 1.01.00", an_o_actual, 1, 12, "123", 123, total_debe, total_haber)
MsgBox total_debe
MsgBox total_haber
End Sub
Private Sub Form_Load()
'oculta los frames
Call oculta_frames
pbx_principal.Visible = True
pbx_principal.Top = lbl_titulo.Top + lbl_subtitulo.Height + lbl_titulo.Height
pbx_principal.Left = 660 + 2895 + 200
'mostar_adv = True
Dim cod_fii As String
mes_anterior = 0
lbl_titulo.Caption = "Año Actual: " & "No asignado."
lbl_subtitulo.Caption = "Mes: " & "No asignado."
End Sub
Private Sub Form_Terminate()
Call obj_log.Registra(login_usu, 24, " ")
End Sub
Private Sub Label10_Click()
rep_eje_pda.Show
End Sub
Private Sub Label11_Click()
'muestra los compromisos
reportes_valor = 1
rep_compromisos.Show 1, frm_principal
End Sub
Private Sub Label12_Click()
'muestra los causados
reportes_valor = 2
rep_compromisos.Show 1, frm_principal
End Sub
Private Sub Label13_Click()
'DataReport3.Show
reportes_valor = 3
rep_compromisos.Show 1, frm_principal
End Sub
Private Sub Label14_Click()
reportes_valor = 4
rep_compromisos.Show 1, frm_principal
End Sub
Private Sub Label15_Click()
frm_cierre_nom_mod.Show 1, frm_principal
End Sub
Private Sub Label16_Click()
If an_o_actual = 2006 Then
frm_gastos_c_modificar.Show 1, frm_principal
Else
frm_gcmod_2007.Show 1, frm_principal
End If
End Sub
Private Sub Label17_Click()
rep_eje_proy_todos.Show 1, frm_principal
End Sub
Private Sub Label18_Click()
rep_gastos_centro.Show
End Sub
Private Sub Label19_Click()
rep_eje_proy_jj.Show
End Sub
Private Sub Label20_Click()
frm_formula_p.Show 1, frm_principal
End Sub
Private Sub Label21_Click()
frm_precompromiso.Show 1, frm_principal
End Sub
Private Sub Label22_Click()
frm_compromiso.Show 1, frm_principal
End Sub
Private Sub Label23_Click()
frm_gastos_pagados_2007.Show 1, frm_principal
End Sub
Private Sub Label27_Click()
frm_compromiso_mod.Show 1, frm_principal
End Sub
Private Sub Label24_Click()
rep_2007.Show 1, frm_principal
End Sub
Private Sub Label25_Click()
rep_disp_2007.Show 1, frm_principal
End Sub
Private Sub Label26_Click()
frm_precompromiso_mod.Show 1, frm_principal
End Sub
Private Sub Label28_Click()
frm_pagado_mod.Show 1, frm_principal
End Sub
Private Sub Label29_Click()
rep_may_2007.Show 1, frm_principal
End Sub
Private Sub Label3_Click()
frm_usuarios.Show
End Sub
Private Sub Label30_Click()
rep_eje_proy_2007.Show 1, frm_principal
End Sub
Private Sub Label31_Click()
rep_eje_proy_jj_2007.Show 1, frm_principal
End Sub
Private Sub Label33_Click()
frm_elim_proy.Show 1, frm_principal
End Sub
Private Sub Label34_Click()
rep_eje_fin.Show 1, frm_principal
End Sub
Private Sub Label35_Click()
rep_eje_fin_res.Show 1, frm_principal
End Sub
Private Sub Label40_Click()
End Sub
Private Sub Label36_Click()
frm_fuenteproying.Show 1, frm_principal
End Sub
Private Sub Label37_Click()
frm_trasf_mod.Show 1, frm_principal
End Sub
Private Sub Label41_Click()
frm_fuentefin.Show 1, frm_principal
End Sub
Private Sub Label5_Click()
frm_fuenteproy.Show 1, frm_principal
End Sub
Private Sub Label8_Click()
frm_cambio_clave.Show
End Sub
Private Sub lbl_anular_pago_Click()
'si el presupuesto actual se encuentra abierto
Dim objpre As New Presupuesto
Dim rs_pre As New ADODB.Recordset
Set rs_pre = objpre.Consulta_datos_presupuesto(pre_cod_actual, an_o_actual)
If rs_pre!pre_cod_status <> 3 Then
MsgBox "No se pueden anular gastos debido a que no existe ningún presupuesto en Ejecución."
Exit Sub
End If
frm_gastos_anular.Show 1
End Sub
Private Sub lbl_anular_Click()
If an_o_actual = 2006 Then
frm_anular.Show 1, frm_principal
Else
frm_anular_2007.Show 1, frm_principal
End If
End Sub
Private Sub lbl_asing_caja_Click()
frm_cajas_todas.Show 1, frm_principal
End Sub
-----------------------------------------------------------------------------------------------
AQUI ES DONDE ME DA EL ERROR
Private Sub lbl_asoc_cc_Click()
Dim objpre As New Presupuesto
Dim rs_pre As New ADODB.Recordset
Set rs_pre = objpre.Consulta_datos_presupuesto(pre_cod_actual, an_o_actual)
If rs_pre!pre_cod_status <> 1 Then <--- LINEA DE ERROR
MsgBox "El presupuesto actual se encuentra en Ejecución. No es posible modificar esta opción."
Exit Sub
End If
frm_asoc_cc.Show
End Sub
--------------------------------------------------------------------------------------------------
Private Sub lbl_cambedo_Click(Index As Integer)
'si el presupuesto actual se encuentra abierto
Dim objpre As New Presupuesto
Dim rs_pre As New ADODB.Recordset
Set rs_pre = objpre.Consulta_datos_presupuesto(pre_cod_actual, an_o_actual)
If rs_pre!pre_cod_status <> 3 Then
MsgBox "No se pueden modificar gastos debido a que no existe ningún presupuesto en Ejecución."
Exit Sub
End If
frm_gastos_edo.Show 1, frm_principal
End Sub.......................
LA VERDAD ES QUE HE CHEQUEADO MI BD's HE BUSCADO EN DIFERENTES PAGINAS DE AYUDA DE VISUAL BASIC 6.0, PERO YA NO SE QUE HACER SI ALGUIEN ME PUEDE AYUDAR SE LO AGRADECER MUCHISISISIMO.....
MI PROGRAMA ESTA EN VISUAL BASIC 6.0
LA BD's EN SQL SERVER 2000
TODO LO TENGO CON CONEXION LOCAL ES DECIR DESDE DE MI PC