Combo
Publicado por Tony (17 intervenciones) el 08/11/2006 13:28:08
Intento rellenar un combo con los datos de una tabla producto de una base de datos acces, pero no me funciona. Aquí os pongo el codigo para ver que es lo que hago mal.
El modulo:
Option Explicit
Private Const BD_BAS = "D:\Datos Toni\Bascula\Bascula1.mdb"
Private Const BD_TEMPORAL = "D:\Datos Toni\Bascula\Bascula1.tmp"
Public dbBascula As Database
Public codcli As Integer
Public codInmueb As Integer
Public Sub Main()
FrmBasula.Show
Call AbrirBD
End Sub
Public Sub AbrirBD()
Dim intOpc
On Error GoTo ErrAbrirBD
Call CerrarBD
If Dir(BD_BAS) = "" Then
MsgBox "El fichero de BD no existe." + vbCrLf & vbCrLf _
& "Ruta\Fichero: " & BD_BAS & vbCrLf & vbCrLf _
& "Ejecute la opción 'Crear Nueva BD' del menú principal"
Exit Sub
End If
Set dbBascula = OpenDatabase(BD_BAS, True)
Exit Sub
ErrAbrirBD:
intOpc = MsgBox("Error al intentar abrir la base de datos" & vbCrLf _
& Err.Description, _
vbExclamation + vbAbortRetryIgnore, _
"Abrir BD")
Select Case intOpc
Case vbAbort
End
Case vbRetry
Resume Next
Case vbIgnore
Exit Sub
End Select
End Sub
Public Function CerrarBD()
If Not dbBascula Is Nothing Then
dbBascula.Close
Set dbBascula = Nothing
End If
End Function
Public Function AccederBD() As Database
Set AccederBD = dbBascula
End Function
Public Function AccederTabla(strNombreTabla) As Recordset
On Error GoTo ErrAccederTabla
Set AccederTabla = dbBascula.OpenRecordset(strNombreTabla, dbOpenTable)
Exit Function
ErrAccederTabla:
MsgBox "Error al intentar acceder a la tabla: " & strNombreTabla & vbCrLf _
& Err.Description, _
vbExclamation, _
"[Nucleo.bas], AccederTabla()"
End Function
EL formulario:
Private Sub cboProducto_Click()
Dim rstProducto As Recordset
Set rstProducto = AccederTabla("Productos")
With cboProducto
If .ListIndex <> -1 Then
txtProducto = .ItemData(.ListIndex)
End If
End With
With rstProducto
If Not .BOF And Not .EOF Then .MoveFirst
While Not .EOF
If txtProducto = !CPRODUCTO Then
lblNombreProd.Caption = !DPRODUCTO
End If
.MoveNext
Wend
End With
End Sub
Function RellenarCboProducto()
Dim rstProducto As Recordset
Set rstProducto = AccederTabla("Productos")
With rstProducto
If Not .BOF And Not .EOF Then .MoveFirst
While Not .EOF
cboInmueble.AddItem !DPRODUCTO
cboInmueble.ItemData(cboInmueble.NewIndex) = !CPRODUCTO
.MoveNext
Wend
End With
End Function
Private Sub Form_Load()
Call RellenarCboProducto
.
.
.
End Sub
El error que me sale es el siguiente:
Error al intentar acceder a la tabla: Producto
Variable de tipo Object o la variable de bloque With no está establecida
El modulo:
Option Explicit
Private Const BD_BAS = "D:\Datos Toni\Bascula\Bascula1.mdb"
Private Const BD_TEMPORAL = "D:\Datos Toni\Bascula\Bascula1.tmp"
Public dbBascula As Database
Public codcli As Integer
Public codInmueb As Integer
Public Sub Main()
FrmBasula.Show
Call AbrirBD
End Sub
Public Sub AbrirBD()
Dim intOpc
On Error GoTo ErrAbrirBD
Call CerrarBD
If Dir(BD_BAS) = "" Then
MsgBox "El fichero de BD no existe." + vbCrLf & vbCrLf _
& "Ruta\Fichero: " & BD_BAS & vbCrLf & vbCrLf _
& "Ejecute la opción 'Crear Nueva BD' del menú principal"
Exit Sub
End If
Set dbBascula = OpenDatabase(BD_BAS, True)
Exit Sub
ErrAbrirBD:
intOpc = MsgBox("Error al intentar abrir la base de datos" & vbCrLf _
& Err.Description, _
vbExclamation + vbAbortRetryIgnore, _
"Abrir BD")
Select Case intOpc
Case vbAbort
End
Case vbRetry
Resume Next
Case vbIgnore
Exit Sub
End Select
End Sub
Public Function CerrarBD()
If Not dbBascula Is Nothing Then
dbBascula.Close
Set dbBascula = Nothing
End If
End Function
Public Function AccederBD() As Database
Set AccederBD = dbBascula
End Function
Public Function AccederTabla(strNombreTabla) As Recordset
On Error GoTo ErrAccederTabla
Set AccederTabla = dbBascula.OpenRecordset(strNombreTabla, dbOpenTable)
Exit Function
ErrAccederTabla:
MsgBox "Error al intentar acceder a la tabla: " & strNombreTabla & vbCrLf _
& Err.Description, _
vbExclamation, _
"[Nucleo.bas], AccederTabla()"
End Function
EL formulario:
Private Sub cboProducto_Click()
Dim rstProducto As Recordset
Set rstProducto = AccederTabla("Productos")
With cboProducto
If .ListIndex <> -1 Then
txtProducto = .ItemData(.ListIndex)
End If
End With
With rstProducto
If Not .BOF And Not .EOF Then .MoveFirst
While Not .EOF
If txtProducto = !CPRODUCTO Then
lblNombreProd.Caption = !DPRODUCTO
End If
.MoveNext
Wend
End With
End Sub
Function RellenarCboProducto()
Dim rstProducto As Recordset
Set rstProducto = AccederTabla("Productos")
With rstProducto
If Not .BOF And Not .EOF Then .MoveFirst
While Not .EOF
cboInmueble.AddItem !DPRODUCTO
cboInmueble.ItemData(cboInmueble.NewIndex) = !CPRODUCTO
.MoveNext
Wend
End With
End Function
Private Sub Form_Load()
Call RellenarCboProducto
.
.
.
End Sub
El error que me sale es el siguiente:
Error al intentar acceder a la tabla: Producto
Variable de tipo Object o la variable de bloque With no está establecida
Valora esta pregunta


0