UserForm dynamisch mit Objekten versehen

In diesem Beitrag zeige ich, wie man ein UserForm dynamisch mit Objekten versehen kann. Somit kann das vorgestellte UserForm universell als Eingabemaske verwendet werden.

Zunächst wird im Visual Basic-Editor ein Formular erzeugt, das etwa so aussehen sollte:

Diese Quelltexte werden in das Modul des UserForms geschrieben:

Option Explicit 
Dim sziel As Integer 
Dim zziel As Integer 
' geschrieben von Klaus-Dieter Oppermann (2004) 
' Die Makros dürfen frei verwendet werden, solange 
' mein Name nicht entfernt wird 
 
Private Sub CommandButton1_Click() 
' Variablen deklarieren 
Dim arr As Variant 
Dim obj As Object 
Dim sp As Integer 
Dim test As Integer 
zziel = ActiveCell.SpecialCells(xlLastCell).Row + 1     ' erste freie Zeile suchen 
' Daten in Tabelle übertragen 
For Each obj In Me.Controls                             ' Objekte suchen 
    If Left(TypeName(obj), 7) = "TextBox" Then          ' wenn TextBox dann ... 
        sp = sp + 1                                     ' ... Spaltenzähler +1 
        Cells(zziel, sp) = obj.Value                    ' ...Inhalt der Textbox in Tabelle schreiben 
    End If                                              ' Ende der Schleife 
Next obj 
End Sub 
 
Private Sub CommandButton2_Click() 
' Userform schließen 
UserForm1.Hide 
End Sub 
 
Private Sub UserForm_Initialize() 
' Startparameter an UserForm übergeben 
' Variablen deklarieren 
Dim tbrg As Excel.Range 
Dim lbrg As Excel.Range 
Dim tebo As MSForms.TextBox 
Dim lbl As MSForms.Label 
Dim w As Long 
Dim x As Long 
' Werte zuweisen 
sziel = ActiveCell.SpecialCells(xlLastCell).Column      'letzte Spalte mit Inhalt ermitteln 
Height = sziel * 20 + 75                                ' Höhe des UserForm aus Anzahl der Objekte berechnen 
Caption = "Daten eingeben     © Klaus-Dieter Oppermann" ' Titel festlegen 
' Textboxen erzeugen 
Range("A" & ActiveCell.SpecialCells(xlLastCell).Row + 1, _
Chr(ActiveCell.SpecialCells(xlLastCell).Column + 64) & _
ActiveCell.SpecialCells(xlLastCell).Row + 1).Select     ' Anzahl der TextBoxen festlegen 
x = 15                                                  ' Variable für Positionierung der ersten TextBox 
w = 10                                                  ' Variable für Positionierung der ersten Beschriftung 
For Each tbrg In Selection                              ' Start der Schleife zum Erzeugen der TextBoxen 
    Set tebo = Me.Controls.Add("Forms.TextBox.1")       ' TextBox zufügen 
        With tebo                                       ' Parameter für Textbox ... 
            .Left = 110                                 ' ... Position linke Seite 
            .Top = w                                    ' ... Oberkante 
            .Width = 120                                ' ... Breite 
        End With                                        ' Ende Parameter übergeben 
    w = w + 20                                          ' Variable für Oberkante hochzählen 
Next tbrg                                               ' Wendepunkt für Schleife 
' Beschriftungen (Labels) erzeugen 
Range("A1", Chr(ActiveCell.SpecialCells(xlLastCell). _
Column + 64) & 1).Select                                ' Anzahl der Beschriftungen ermitteln 
For Each lbrg In Selection                              ' Start der Schleife zum Erzeugen der Labels 
    Set lbl = Me.Controls.Add("Forms.Label.1")          ' Label zufügen 
        With lbl                                        ' Parameter für Label ... 
            .Caption = lbrg.Value                       ' ... Text zuweisen 
            .Font.Bold = True                           ' ... Schriftart = Fett 
            .Left = 30                                  ' ... Position linke Seite 
            .Top = x                                    ' ... Position Oberkante 
            .Width = 70                                 ' ... Breite 
        End With                                        ' Ende Parameter übergeben 
    x = x + 20                                          ' Variable für Oberkante hochzählen 
Next lbrg                                               ' Wendepunkt für Schleife 
Cells(1, 1).Select                                      ' Zelle A1 selektieren 
With CommandButton1                                     ' Parameter an Schaltfläche 1 übergeben ... 
    .Top = sziel * 20 + 18                              ' ... Punkt für Oberkante berechnen 
    .Caption = "Daten eintragen"                        ' ... Text eintragen 
    .Font.Bold = True                                   ' ... Schriftart = Fett 
    .ForeColor = &HFF0000                               ' ... Schriftfarbe = blau 
    .Left = 132                                        ' ... Position linke Seite 
End With                                                ' Ende Parameter übergeben 
With CommandButton2                                     ' Parameter an Schaltfläche 2 übergeben ... 
    .Top = sziel * 20 + 18                              ' ... Punkt für Oberkante berechnen 
    .Caption = "Formular schließen"                     ' ... Text eintragen 
    .Font.Bold = True                                   ' ... Schriftart = Fett 
    .ForeColor = &HFF&                                  ' ... Schriftfarbe = rot 
    .Left = 24                                         ' ... Position linke Seite 
End With                                                ' Ende Parameter übergeben 
End Sub                                                 ' Ende Makro