Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Formularreferenzen auf UFOs/UFO-Container vereinfacht
zurück: Kalenderwoche nach DIN1355 mit/ohne Jahreszahl weiter: Prozesssteuerung über eine Tabelle Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Bitsqueezer
Office-VBA-Programmierer


Verfasst am:
24. Feb 2010, 14:19
Rufname:

Formularreferenzen auf UFOs/UFO-Container vereinfacht - Formularreferenzen auf UFOs/UFO-Container vereinfacht

Nach oben
       Version: (keine Angabe möglich)

Hallo zusammen,

wenn man mit Access mit Formularen (HFO) und Unterformularen (UFO) arbeitet, dann bietet Access eine Reihe verschiedener Möglichkeiten, diese zu referenzieren. Zunächst werden diese in einen Unterformularcontainer gesteckt, den ich hier mal "SFC" für Subformcontainer nenne.
Unter den Referenzmöglichkeiten sind so schöne Konstrukte wie:
Code:
Form_HFOName.SFC.Form
Forms!HFOName!SFC.Form
Forms("HFOName").Controls("SFC").Form
Wenn man jetzt im Unterformular noch ein Unterformular hat, verdoppelt sich die Länge des Zugriffkonstruktes, z.B. so:
Code:
Form_HFOName.SFC.Form.UFOName.SFCimUFO.Form
Spätestens ab der dritten Ebene spielt VBA nicht mehr mit (IntelliSense gibt schon früher auf), dann muß man einen Zwischenschritt machen und ein Formobjekt zuweisen, um wiederum dessen Unterobjekte zu erhalten.

Problematisch wird es auch, wenn man ein Formular wiederverwenden will, mal als Unterformular in einem übergeordneten Formular, mal als "Standalone" und mal vielleicht in zweiter Ebene verschachtelt.

Um dieses Dilemma allgemein zu lösen, habe ich nun folgende beide Klassen gebaut, mit denen man von überall her auf jedes Formular (und als kleine Zugabe auch auf die SFC-Objekte, die man mit "Parent" beispielsweise nicht erreichen kann) zugreifen kann.

Zur Verwendung müssen beide als getrennte Klassenmodule gespeichert werden.

clsCCFormRefs
Code:
'---------------------------------------------------------------------------------------
' Modul     : clsCCFormRefs
' Autor     : Christian Coppes
' Datum     : 24.02.2010
' Zweck     : Gibt eine direkte Zugriffsmöglichkeit für beliebig tief verschachtelte
'             Unterformulare
'             Das Unterformular muß dabei nicht wissen, ob es selbst ein Hauptformular
'             ist oder in einem Unterformularcontainer steckt.
'             Bei Übergabe eines Form-Objektes, das ein Unterformular eines anderen
'             Objektes ist, wird automatisch die komplette Formularstruktur erstellt,
'             in der sowohl das Hauptformular, alle seine Unterformulare, deren Container-
'             objekte und alle weiter verschachtelten Unterformulare und deren Container-
'             objekte enthalten ist.
'---------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

Private prv_frmMain As Form
Private prv_colFormRef As Collection
Private prv_bytLevelCounter As Byte

' -------- Referenz zum Hauptformular ---------
Public Property Get FormMain() As Form
    Set FormMain = prv_frmMain
End Property

Public Property Set FormMain(frm As Access.Form)
    Set prv_frmMain = frm
End Property

' -------- das Formularobjekt anhand seines Namens oder zusätzlich anhand des
'          Namens des übergeordneten Formulars finden
Public Property Get Form(strName As String _
                       , Optional strParentName As String = "") As Access.Form
    Dim i As Byte, k As Byte
   
    Set Form = Nothing
    If strName = "" Then Exit Property
    If strName = prv_frmMain.Name Then
        Set Form = prv_frmMain.Form
        Exit Property
    End If
    If prv_colFormRef Is Nothing Then Exit Property
    If prv_colFormRef.Count = 0 Then Exit Property
    For i = 1 To Me.Count
        If prv_colFormRef.Count > 0 Then
            For k = 1 To prv_colFormRef(i).SubForm.Count
                If Not prv_colFormRef(i).SubForm(k) Is Nothing Then
                    If prv_colFormRef(i).SubForm(k).Name = strName Then
                        If strParentName <> "" Then
                            If prv_colFormRef(i).FormParent.Name _
                                                          = strParentName Then
                                Set Form = prv_colFormRef(i).SubForm(k).Form
                                Exit Property
                            End If
                          Else
                            Set Form = prv_colFormRef(i).SubForm(k).Form
                            Exit Property
                        End If
                    End If
                End If
            Next k
        End If
    Next i
   
End Property

' -------- das Subform-Objekt anhand des Formularnamens oder zusätzlich anhand
'          des Namens des übergeordneten Formulars finden
Public Property Get FormSFContainer(strName As String _
                                  , Optional strParentName As String = "") _
                                   As Access.SubForm
    Dim i As Byte, k As Byte
   
    Set FormSFContainer = Nothing
    If strName = prv_frmMain.Name Or strName = "" Then Exit Property
    If prv_colFormRef Is Nothing Then Exit Property
    If prv_colFormRef.Count = 0 Then Exit Property
    For i = 1 To prv_colFormRef.Count
        If prv_colFormRef.Count > 0 Then
            For k = 1 To prv_colFormRef(i).SubForm.Count
                If Not prv_colFormRef(i).SubForm(k) Is Nothing Then
                    If prv_colFormRef(i).SubForm(k).Name = strName Then
                        If strParentName <> "" Then
                            If prv_colFormRef(i).FormParent.Name = strParentName Then
                                Set FormSFContainer = prv_colFormRef(i).SFControl(k)
                                Exit Property
                            End If
                          Else
                            Set FormSFContainer = prv_colFormRef(i).SFControl(k)
                            Exit Property
                        End If
                    End If
                End If
            Next k
        End If
    Next i
End Property

' -------- Subform-Collection --------------
' Diese Collection enthält die Datenobjekte vom Typ clsCCFormRefData
Public Property Get FormRef() As Collection
    Set FormRef = prv_colFormRef
End Property

' -------- Anzahl gefundener Unterformulare -------
Public Property Get Count() As Long
    Count = prv_colFormRef.Count
End Property

' -------- Komplette Formularstruktur erstellen --------
Public Sub GetForms(frm As Access.Form)
    If Not prv_colFormRef Is Nothing Then
        Set prv_colFormRef = New Collection
        prv_bytLevelCounter = 0
    End If
    ' War das übergebene frm-Objekt nicht das Hauptformular, zuerst
    ' das Hauptformular identifizieren
    Set prv_frmMain = fnFindMainForm(frm)
    ScanSubforms prv_frmMain
End Sub

' -------- Rekursiv alle Unterformulare in jeder Tiefe holen und
'          in der Collection speichern
Private Sub ScanSubforms(frm As Access.Form)
    Dim oRD As New clsCCFormRefData
    Dim i As Byte
   
    Set oRD = fnGetSubforms(frm)
    If oRD.Count = 0 Then Exit Sub
    ' gefundene Subforms der Collection zusammen mit dem Level hinzufügen
    prv_colFormRef.Add oRD, Trim(Str(prv_bytLevelCounter)) & "," & frm.Name
    prv_bytLevelCounter = prv_bytLevelCounter + 1
    ' nächste Ebene scannen
    For i = 1 To oRD.Count
        If Not oRD.SubForm(i) Is Nothing Then ScanSubforms (oRD.SubForm(i))
    Next
End Sub
   
' ---------- Unterformulare des übergebenen Formulars holen
Private Function fnGetSubforms(frm As Access.Form) As clsCCFormRefData
    Dim oRD As New clsCCFormRefData
   
    oRD.LoadSubforms frm, prv_bytLevelCounter
    Set fnGetSubforms = oRD
End Function

' Wurde in "GetForms" die Referenz auf ein Unterformular übergeben,
' sucht diese Funktion das Formular der obersten Formularebene
Private Function fnFindMainForm(frm As Access.Form) As Access.Form
    Dim frmResult As Access.Form
   
    Set frmResult = frm
    On Error Resume Next
    Do
        Set frmResult = frmResult.Parent.Form
    Loop Until Err.Number = 2452
    Set fnFindMainForm = frmResult
End Function

' ------- Konstruktor/Destruktor
Private Sub Class_Initialize()
    prv_bytLevelCounter = 0
    Set prv_colFormRef = New Collection
End Sub

Private Sub Class_Terminate()
    Set prv_colFormRef = Nothing
End Sub
sowie das dazugehörige Datenobjekt unter dem Namen

clsCCFormRefData
Code:
'-----------------------------------------------------------------------------
' Modul     : clsCCFormRefData
' Autor     : Christian Coppes
' Datum     : 24.02.2010
' Zweck     : Datenobjekt für die Klasse clsCCFormRefs.
'             Speichert für ein übergebenes Formular den Level, die Anzahl
'             UFOs, die Referenzen zu den UFO-Containern und die Referenzen zu
'             den darin enthaltenen Formularen.
'             Enthält ein UFO-Container kein Formular, wird nur die Referenz
'             auf den Container gespeichert.
'-----------------------------------------------------------------------------

Option Compare Database
Option Explicit

Private prv_frmParent As Form
Private prv_colSubformControls As Collection
Private prv_colSubforms As Collection
Private prv_lngCount As Long
Private prv_bytLevel As Byte

' -------- Verschachtelungsebene --------------
Public Property Get Level() As Byte
    Level = prv_bytLevel
End Property

Public Property Let Level(ByVal bytLevel As Byte)
    prv_bytLevel = bytLevel
End Property

' -------- Referenz zum Elternformular ---------
Public Property Get FormParent() As Form
    Set FormParent = prv_frmParent
End Property

Public Property Set FormParent(frm As Access.Form)
    Set prv_frmParent = frm
End Property

' -------- SubformControls-Collection ----------
Public Property Get SFControl() As Collection
    Set SFControl = prv_colSubformControls
End Property

' -------- Subform-Collection --------------
Public Property Get Subform() As Collection
    Set Subform = prv_colSubforms
End Property

' -------- Anzahl Unterformulare in diesem Formular
Public Property Get Count() As Long
    Count = prv_lngCount
End Property

' -------- Objekt initialisieren und Collections mit den Unterformularen/
'          Containern füllen
Public Sub LoadSubforms(frm As Access.Form, bytLevel As Byte)
    Set Me.FormParent = frm
    procGetAllSubforms
    Me.Level = bytLevel
End Sub

' -------- Collections mit den Unterformularen/Containern füllen
Private Sub procGetAllSubforms()
    Dim ctl As Access.Control
    Dim i As Long
    i = 0
    Set prv_colSubformControls = New Collection
    Set prv_colSubforms = New Collection
    For Each ctl In prv_frmParent
        If TypeOf ctl Is Subform Then
            prv_colSubformControls.Add ctl, ctl.Name
            If ctl.SourceObject <> "" Then
                prv_colSubforms.Add ctl.Form, ctl.Name
              Else
                prv_colSubforms.Add Nothing, ctl.Name
            End If
            i = i + 1
        End If
    Next ctl
    prv_lngCount = i
End Sub

' -------- Destruktor
Private Sub Class_Terminate()
    Set prv_frmParent = Nothing
    Set prv_colSubforms = Nothing
    Set prv_colSubformControls = Nothing
End Sub
Die Verwendung ist dann sehr einfach:

Beispielsweise speichert man in einem beliebigen Formularobjekt eine formularglobale Objektvariable auf die Klasse clsCCFormRefs:
Code:
Private oFR As clsCCFormRefs

Private Sub Form_Load()
   Set oFR = New clsCCFormRefs
   oFR.GetForms Me
End Sub
"Me" ist ja die Form-Referenz auf das eigene Formular. Die Klasse sucht nun das höchste Formular für diese Formularreferenz heraus und beginnt von dort, das Hauptformular nach allen SFCs zu durchsuchen, nimmt deren Referenzen und deren Formularobjekte (falls es nicht ein leerer Container war) und speichert diese in einer Collection.
Im Gegensatz zu der Access-Zugriffsmethode hat man nun nicht mehr einen tief verschachtelten Pfad, sondern eine "flache" Ebene, in der alle Formularobjekte enthalten sind.

Um die Referenz auf ein Formularobjekt zu erhalten, kann man nun einfach so darauf zugreifen:
Code:
    Dim frm As Access.Form
   
    Set frm = oFR.Form("NamedesFormulars")
    If Not frm Is Nothing Then
        ' frm in irgendeiner Form verwenden
    End If
Auf den Container kann man zugreifen mit:
Code:
    Dim sf As Access.Subform
   
    Set sf = oFR.FormSFContainer("NamedesFormulars")
    If Not sf Is Nothing Then
        ' sf in irgendeiner Form verwenden
    End If
Es wird immer entweder die Referenz auf das gefundene Objekt zurückgegeben oder "Nothing", wenn das Objekt nicht gefunden wurde (bzw. im Fall der Subformcontainer, wenn es ein Hauptformular ist, das nicht in einem Container steckt).
Es werden auch die Subformcontainer in die Collection aufgenommen, deren SourceObject-Eigenschaft leer ist, die zugehörige Form bekommt dann den Inhalt "Nothing".

Fügt man den Code zum Erstellen des Objektes wie oben gezeigt in Form_Load in jedem Formular ein, dann kann jedes Formular auf jedes andere Formular aus der gleichen HFO/UFO Kombination zugreifen, egal wie tief die Verschachtelung ist (der Counter ist als Byte dimensioniert, aber diese Tiefe wird wohl nie erreicht werden).

Besonders interessant ist diese Zugriffsmethode, wenn man für die Formulare einen universellen Code schreiben möchte, der nicht Bestandteil des Formularcodes ist, sondern der nur eine Referenz auf ein Formular erhält. Der generische Code "weiß" dann nicht, ob das Formular ein HFO oder UFO ist, kann über ein solches Objekt aber die gesamte Formularstruktur laden und auf alle Teile zugreifen, ohne mit verzwickten Access-Konstrukten jonglieren zu müssen.

Entwickelt unter Access 2007, sollte aber gleichermaßen auch in älteren Access-Versionen funktionieren.

Sollte jemand noch Fehler finden oder eigene Anregungen dazu haben, freue mich immer über Feedback.

Gruß

Christian
Willi Wipp
Moderator


Verfasst am:
13. Jul 2013, 05:11
Rufname:
Wohnort: Raum Wiesbaden


Re: Formularreferenzen auf UFOs/UFO-Container vereinfacht - Re: Formularreferenzen auf UFOs/UFO-Container vereinfacht

Nach oben
       Version: (keine Angabe möglich)

Nachfragen zum Thema bitte in Form.-Ref. auf UFOs/UFO-Container vereinfacht {Nachgefragt} stellen.
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp

(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Access Programmierung / VBA: Form.-Ref. auf UFOs/UFO-Container vereinfacht {Nachgefragt} 6 Gast 190 19. Feb 2014, 18:07
JensFliese66 Form.-Ref. auf UFOs/UFO-Container vereinfacht {Nachgefragt}
Keine neuen Beiträge Access Formulare: Probleme mit Ufos 1 KKJ 94 30. Aug 2013, 07:27
Willi Wipp Probleme mit Ufos
Keine neuen Beiträge Access Formulare: Ereignisreihenfolge von mehreren Ufos ändern 5 Boerek 85 17. Jul 2013, 11:06
MissPh! Ereignisreihenfolge von mehreren Ufos ändern
Keine neuen Beiträge Access Formulare: Berechnung im HF mit Werten aus mehreren UFOs 2 Markus83 83 06. März 2013, 12:01
Markus83 Berechnung im HF mit Werten aus mehreren UFOs
Keine neuen Beiträge Access Formulare: Ist die anzahl an Ufos in einem Formular begrenzt? 4 steli 89 06. Feb 2013, 18:35
KlausMz Ist die anzahl an Ufos in einem Formular begrenzt?
Keine neuen Beiträge Access Berichte: Formularinhalt in Bericht drucken - einige ufos fehlerhaft 20 obroa 622 20. Aug 2012, 16:30
obroa Formularinhalt in Bericht drucken - einige ufos fehlerhaft
Keine neuen Beiträge Access Formulare: Kombinationsfeldabfrage in abhängigen Ufo`s 17 robbitobbi 411 29. März 2012, 15:39
MissPh! Kombinationsfeldabfrage in abhängigen Ufo`s
Keine neuen Beiträge Access Formulare: Berechnung Summe aus 2 UFOs 1 Gast 296 24. März 2011, 11:25
Gast Berechnung Summe aus 2 UFOs
Keine neuen Beiträge Access Programmierung / VBA: CommandButton ach für UFO's? 4 Prexx 187 25. Okt 2010, 16:26
Prexx CommandButton ach für UFO's?
Keine neuen Beiträge Access Formulare: Datenblatt mit 2 Ufos 0 frodo111 189 13. Sep 2010, 09:10
frodo111 Datenblatt mit 2 Ufos
Keine neuen Beiträge Access Programmierung / VBA: von einem Ufo auf ein Feld eines anderen Ufos zugreifen 4 Toblerone 388 05. Mai 2010, 07:08
Toblerone von einem Ufo auf ein Feld eines anderen Ufos zugreifen
Keine neuen Beiträge Access Formulare: komplexe Suchabfrage über HFo's und UFo's 2 Emin 402 09. Jul 2008, 10:19
Emin komplexe Suchabfrage über HFo's und UFo's
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: CSS Forum