---

Hi forum,
ich möchte in einem userformular die combobox nicht mühsam über .additem füllen sondern direkt eine rowsource zuweisen.

probiert habe ich es wie folgt:

Code:

---

    Set dbs = DBEngine.Workspaces(0).OpenDatabase("C:\db_BE.mdb")
    Me.cmbTTp.RowSource = "SELECT dbs.Beschr.* FROM dbs.Beschr;"

---

probiert habe ich es auch mit:

Code:

---

Me.cmbTTp.RowSource = "SELECT " & dbs.TableDefs("Beschr").Name & ".* FROM " & dbs.TableDefs("Beschr").Name & ";"

---

die direkte zuweisung nach obigem muster nimmt VBA nicht an. das nachstehende recordset macht allerdings keine probleme. die datenbank ist also im zugriff.

Code:

---

    Set rst2 = dbs.OpenRecordset("SELECT Beschr.* FROM Beschr;")

---

zur erläuterung: ich habe die code-schnipsel aus dem original mit "STRG+C" und "STRG+V" eingefügt. sollten also tippfehler drin sein (ich nicht finde), dann sind die auch im originalcode und wohl fehlerursache. aber ist dem so?
bernd

------------------

Bernd

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

Ich weiss nicht wo der Code herkommt "DBEngine.Workspaces.." ?
Sieht wie DAO oder CAO aus.

Ich hab mir da eine Klasse gemacht die die Kennungslisten aus der Datenbank holt. Übergibst nur den Namen der Datenbank und fertig.
Dann stehen die Listen in einer Collection zur Verfügung.

Code:

---

' **** Klassenmodul cls_Kennungen
Option Explicit

Public Kennung As Variant
Public Value As String

'  *** Klassenmodul cls_Datenbank ***
Option Explicit

Dim vlst_VorlageMDB As String
Public ogdb_Connection As New ADODB.Connection
Dim vlcl_Strangfunktion As Collection
Dim vlcl_Eigentum As Collection

Property Get VorlageMDB() As String
  VorlageMDB = vlst_VorlageMDB
End Property

Property Get Strangfunktionen() As Collection
  Set Strangfunktionen = vlcl_Strangfunktion
End Property
Property Get Eigentum() As Collection
  Set Eigentum = vlcl_Eigentum
End Property

Property Let VorlageMDB(Datei As String)
Dim tmp$
Dim TestBlockDef As AcadBlock
Dim Msg As String
Dim Blockname As String
Dim Info As Variant

    ' ALte Verbindung schliessen
    On Error Resume Next
    ogdb_Connection.Close
    ' Neue Einrichten
    On Error GoTo 0
    vlst_VorlageMDB = Datei
    ogdb_Connection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & vlst_VorlageMDB & ";Persist Security Info=False"
    ogdb_Connection.CursorLocation = adUseClient
    On Error Resume Next
    ogdb_Connection.Open
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbCritical
        Exit Property
    Else
        On Error GoTo 0
        Set vlcl_Strangfunktion = LeseKennungen("WA_STRANG_FUNKTION", "KENNUNG", "BEZEICHNUNG")
        Set vlcl_Eigentum = LeseKennungen("BA_EIGENTUMSVERHAELTNIS", "ID", "VALUE")
        '  .....       
    End If
    On Error GoTo 0
       
End Property

Private Function LeseKennungen(Tabelle As String, Kennungsfeld As String, Bezeichnung As String) As Collection
Dim tmpCol As New Collection
Dim Eintrag As New cls_Kennung
   
    Set olrs = New ADODB.Recordset
    olrs.ActiveConnection = ogdb_Connection.ConnectionString
    olrs.CursorLocation = adUseClient
    olrs.LockType = adLockOptimistic
    olrs.Source = "select * from " & Tabelle '& " where active=1"
    olrs.Source = Tabelle
    olrs.Open
   
    If olrs.RecordCount > 0 Then
      olrs.MoveFirst
      While Not olrs.EOF
          Set Eintrag = New cls_Kennung
          Eintrag.Kennung = olrs.Fields(Kennungsfeld).Value
          Eintrag.Value = olrs.Fields(Bezeichnung).Value
          tmpCol.Add Eintrag
          olrs.MoveNext
      Wend
    End If
    olrs.Close

    Set LeseKennungen = tmpCol
End Function

---

Um die Listenfelder dann im Auszufüllen

Code:

---

Private Sub UserForm_Initialize()
Dim Eintrag As New cls_Kennung

  ' Fensterposition setzen
    Me.Left = Form_left
    Me.top = Form_top

  ''...
       
    ' Listen vorhanden ???
    If ogdb.Lagegenauigkeit Is Nothing Then
      ogdb.VorlageMDB = GetSetting("IS_VBA_TOOL", "Startup", "MDB", "")
      If ogdb.VorlageMDB = "" Then
          frm_Einstellungen.Show
      End If
    End If
       
    ' Listen füllen
    Me.com_Funktion.Clear
    For Each Eintrag In ogdb.Strangfunktionen
        Me.com_Funktion.AddItem Eintrag.Value
        Me.com_Funktion.List(Me.com_Funktion.ListCount - 1, 1) = Eintrag.Kennung
    Next Eintrag
   
    Me.Com_Eigentum.Clear
    For Each Eintrag In ogdb.Eigentum
        Me.Com_Eigentum.AddItem Eintrag.Value
        Me.Com_Eigentum.List(Me.Com_Eigentum.ListCount - 1, 1) = Eintrag.Kennung
    Next Eintrag
'...

---

Geht recht gut so und kann ruckzuck erweitert werden-

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

uih stelli,
du hast dir ja riesenarbeit gemacht. danke...ich werde mir den code mal vornehmen. wenn ich ihn kapiert und ausprobiert habe, gebe ich rückmeldung. vorab schonmal ein paar sehr verdiente punkte 
bernd

------------------

Bernd

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

einfach in einem Modul deklarieren. Gilt so in allen Modulen

Code:

---

Public ogdb As New cls_Datenbank

---

Und dann die Datenquelle setzen. In diesem Moment werden die Tabellen
in die Klasse OGDB eingelesen.

Code:

---

' Aus Registry
ogdb.VorlageMDB = GetSetting("IS_VBA_TOOL", "Startup", "MDB", "")

' oder FIX
ogdb.VorlageMDB = "C:\TEMP\XY.MDB"

---

Die Einzelnen Einträge stehen dann als Collection zur Verfügung.

Code:

---

' Listen füllen in der Form
ComboBoxFüllen Me.com_Funktion, ogdb.Strangfunktionen
......

' globale Funktion aus Codemodul
Function ComboBoxFüllen(Combo As ComboBox, Source As Collection)
Dim Eintrag As New cls_Kennung
    Combo.Clear
    For Each Eintrag In Source
        Combo.AddItem Eintrag.Value
        Combo.List(Combo.ListCount - 1, 1) = Eintrag.Kennung
    Next Eintrag

End Function

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP