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
Code eingefügt mit: Excel Code Jeanie |
Wenn das UserForm geöffnet wird, werden die Spaltenüberschriften aus der ersten Zeile ausgelesen und im UserForm als Beschriftung übernommen. Weiter wird eine entsprechende Anzahl von TextBoxen zugefügt. Das kann etwa so aussehen:
Durch anklicken der Schaltfläche Daten eintragen werden die Inhalte der TextBoxen in die nächste vollständig freie Zeile der Tabelle eingetragen.
Die Tabelle mit den Makros steht auch im Downloadbereich zur Verfügung.