AW: ControlSource für mehrere Textboxen
25.07.2018 10:18:13
fcs
Hallo Philip,
nachfogend dein Makro korrigiert und meines angepasst, so dass nur noch die Textboxen mit Werten in der Hilfstabelle gelistet werden.
Zusätzlich wird die Bildschirm-Aktualisierung vorrübergehed deaktiviert, was Makros auch beschleunigt.
Gruß
Franz
Dein Makro angepasst
Private Sub UserForm_Initialize()
Dim Zeile, spalte As Integer
Dim mytb As Control
spalte = 13
Zeile = 1
With ThisWorkbook.Sheets("Tabelle2") 'Name ggf. anpassen
For Each mytb In Me.Controls
If LCase(TypeName(mytb)) = "textbox" Then 'so werden auch Textboxen erfasst mit _
anderen Namen erfasst
mytb.ControlSource = "'" & .Name & "'!" & .Cells(Zeile, spalte).Address 'Verkn?pfen
Zeile = Zeile + 1
End If
Next
End With
End Sub
Meine Makros angepasst
'Diese beiden Makros im Userform-Code ergänzen
Private Sub UserForm_Activate()
Dim wksHT As Worksheet
Dim Zeile As Long
Dim objControl As Object
'Werte aus Hilfstabelle in Textboxen einlesen
Set wksHT = ThisWorkbook.Worksheets("Tabelle2") 'Name ggf. anpasen
On Error Resume Next
With wksHT
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile, 1).Text = "" Then Exit Sub 'noch keine Daten in Hilfstabelle
Me.Controls(.Cells(Zeile, 1).Text).Object.Value = .Cells(Zeile, 2)
Next
End With
End Sub
Private Sub UserForm_Terminate()
'Werte aus Textboxen in Hilfstabelle schreiben
Dim wksHT As Worksheet
Dim Zeile As Long
Dim objControl As Object
Set wksHT = ThisWorkbook.Worksheets("Tabelle2") 'Name ggf. anpasen
Application.ScreenUpdating = False
With wksHT
.Range("A:E").Clear
Zeile = 1
.Cells(Zeile, 1) = "Name Textbox"
.Cells(Zeile, 2) = "Wert/Text"
.Cells(Zeile, 3) = "Parent-Element"
.Cells(Zeile, 4) = "Position Open"
.Cells(Zeile, 5) = "Position Links"
.Columns(2).NumberFormat = "@"
For Each objControl In Me.Controls
If LCase(TypeName(objControl)) = "textbox" Then
If objControl.Object.Value "" Then
Zeile = Zeile + 1
.Cells(Zeile, 1) = objControl.Name
.Cells(Zeile, 2) = objControl.Object.Value
.Cells(Zeile, 3) = objControl.Parent.Name
.Cells(Zeile, 4) = objControl.Top
.Cells(Zeile, 5) = objControl.Left
End If
End If
Next objControl
.Range("A:D").EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub