Tipp 2.8 - Formulare in Array

Wie kann ich einem Array die Namen aller Formulare der aktuellen Datenbank übergeben?

Mit dieser Funktion können Sie einem Array die Namen aller Formulare der aktuellen Datenbank übergeben. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Beispiel:

Option Explicit
 
Public Function A2XFrmsToArray(pasIn() As String) _
                               As Integer
  '// =====================================================
  '// Methode   | Übergibt einem Array die Namen aller
  '//           | Formulare der aktuellen DB
  '// -----------------------------------------------------
  '// Parameter | pasIn()  - Array zum Füllen
  '// -----------------------------------------------------
  '// Rückgabe  | Integer -  Anzahl Formulare
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispielaufruf:
  '// Dim iCount    As Integer
  '// Dim iCounter  As Integer
  '// Dim asForms() As String
  '//
  '// iCount = A2XFrmsToArray(asForms)
  '//   Debug.Print "Formulare:"
  '// For iCounter = 0 To iCount - 1
  '//   Debug.Print iCounter & ": " & _
  '//               asForms(iCounter)
  '// Next iCounter
  '// =====================================================
  On Error GoTo HandleErr
  ' Verweis auf DAO 3.6 Object Library muss gesetzt sein!
  Dim dbs As DAO.Database
  Dim con As DAO.Container
  Dim doc As DAO.Document
 
  Dim iCounter As Integer
  Dim iCount   As Integer
  Dim sName    As String
 
  Set dbs = CurrentDb()
  Set con = dbs.Containers("Forms")
 
  iCount = con.Documents.Count
  ReDim pasIn(0 To iCount - 1)
 
  For Each doc In con.Documents
    sName = doc.Name
    pasIn(iCounter) = sName
    iCounter = iCounter + 1
  Next doc
 
  A2XFrmsToArray = iCount
 
HandleExit:
  If Not dbs Is Nothing Then Set dbs = Nothing
  Exit Function
 
HandleErr:
  Select Case Err.Number
    Case Else
      MsgBox "Fehler " & Err.Number & ": " & _
             Err.Description, vbCritical, _
             "basFrm.A2XFrmsToArray"
  End Select
  Resume HandleExit
End Function


Zurück Tipp 2.7 - Controls in String | Inhalt | Tipp 2.9 - Formulare in String Weiter