Office: Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

EarlFred · 14. Mai 2020

kompakter:
Code:

Private msoTB() As clsTextBox
Private m_lngLetzteZeile As Long

Property Get lngLetzteZeile() As Long
If m_lngLetzteZeile = 0 Then
m_lngLetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End If
lngLetzteZeile = m_lngLetzteZeile
End Property

'---------------------------------------
'Ereignisse der Userform
'---------------------------------------
Private Sub UserForm_Initialize()

ReDim msoTB(1 To lngLetzteZeile)

Call TextBoxen(Tabellenspalte:="A", TBName:="Tx", Breite:=150, links:=12)
Call TextBoxen(Tabellenspalte:="B", TBName:="Ty", Breite:=23, links:=170, neuesDatenfeld:=True, TBInKlasse:="TXT")
Call TextBoxen(Tabellenspalte:="C", TBName:="Tz", Breite:=150, links:=190, TBInKlasse:="TXT1")

Call VergleicheUndBunte

End Sub

'---------------------------------------
'Prozeduren
'---------------------------------------

Private Sub TextBoxen( _
ByRef Tabellenspalte As String, _
ByRef TBName As String, _
ByRef Breite As Long, _
ByRef links As Long, _
Optional ByRef neuesDatenfeld As Boolean = False, _
Optional ByRef TBInKlasse As String = "")

Dim c As MSForms.TextBox
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set c = Me.Frame1.Controls.Add("Forms.TextBox.1", TBName & S, True)

With c
.BackColor = &H80000002
.Locked = True
.Height = 15.75
.AutoSize = False
.Width = Breite
.Top = 5 + 18 * S
.Left = links
.ControlSource = Tabellenspalte & S
End With

If neuesDatenfeld Then Set msoTB(S) = New clsTextBox
If TBInKlasse = "TXT" Then Set msoTB(S).TxT = c
If TBInKlasse = "TXT1" Then Set msoTB(S).TxT1 = c

w = w + 20

Next S

Frame1.ScrollBars = fmScrollBarsVertical
Frame1.ScrollHeight = w + 5
End Sub

Private Sub VergleicheUndBunte()
Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)
If IsNumeric(msoTB(i).TxT1.Value) And IsNumeric(msoTB(i).TxT.Value) Then

Select Case True
Case CDbl(msoTB(i).TxT1.Value) > CDbl(msoTB(i).TxT.Value)
msoTB(i).TxT.BackColor = &H80000002
Case CDbl(msoTB(i).TxT1.Value) < CDbl(msoTB(i).TxT.Value)
msoTB(i).TxT.BackColor = RGB(255, 0, 0)
Case Else
msoTB(i).TxT.BackColor = RGB(255, 255, 255)
End Select

End If
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

edwinbastler · 14. Mai 2020

Tausend Dank. Ich mach mich dann drüber her.

edwinbastler · 15. Mai 2020

Vielen Dank für die beiden Versionen. Da brauch ich sicherlich noch ein kleines Stück um das zu kapieren wie es zusammenhängt. Bisher habe ich das Forum eher mal befragt, als selbst mit Problemen anzuklopfen, wo ich nicht weiterkomme, weil die Durchsicht bei mir noch fehlte.
Schönes Wochendende

MfG Uwe

edwinbastler · 27. Mai 2020

Hallo EarlFred,

Ich habe jetzt wieder mal Zeit gefunden und dynamisch erzeugte Buttons dazu genommen. Ich habe den Weg zum Klassenmodul und zurück zur Userform um ein Script aufzurufen auch hinbekommen. Hat eine Weile gebraucht, aber das habe ich nun kapiert.

Klassenmodul "clsCommandButton"
Code:

Option Explicit

Public WithEvents COB1 As MSForms.CommandButton

Private Sub COB1_Click()
Call UserForm1.austesten
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und in der Userform1 folgendes Script, was auch macht was es soll.
Code:

Public Sub austesten()

Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)

SuchBox1 = msoTB(i).TXT2 'übergibt immer nur den Wert der letzten Zelle der Spalte da Schleife

Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da dies eine Schleife ist, landet der letzte Eintrag der ausgelesenen Zelle aus Tabelle1 in der Suchbox, egal welchen Button ich drücke.
Hier will ich eigentlich, dass der jeweilige angeklickte Commandbutton mit der in i enthaltenen Nummer den Wert der nummerngleichen dynamisch erzeugten Textbox TXT2 in die Suchbox übergibt. Da fehlt mir leider die Vorstellung, wie ich das anstellen muss.
Wenn Du Zeit und Lust hast, wäre ich für einen Denkanstoß in die richtige Richtung dankbar.

EarlFred · 28. Mai 2020

Wenn Du Zeit und Lust hast
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

..., kannst Du deine Frage ja noch einmal verständlich beschreiben... *wink.gif*

Und ja, das beschriebene Problem ist nachvollziehbar. Aber irgendwie hast du vergessen zu erzählen, was du eigentlich willst.

Hatten wir auch schon einmal: Bitte zeige allen relevanten Code und nicht nur irgendwelche Schnipsel.

Und warum versuchst du immer noch, aus einer Klasse heraus auf andere Objekte zuzugreifen, die in der Klasse nicht bekannt sind? Ja, wenn es das Objekt zufällig gibt, "geht" das, ist aber vollkommen undurchsichtiger Code.

Zwenn · 28. Mai 2020

Hallo zusammen,

ein kurzer Einwurf dazu. Ich habe nun nicht in die hochgeladene Datei geschaut, weil ich annehme, der Versionsstand ist inzwischen ein anderer. Es gab ja fast 2 Wochen Posting-Pause zwischen dem 15.05. und dem 28.05.

Wenn ich es richtig verstanden habe, geht es darum, Events für dynamisch generierte Steuerelemente auf einer UF auszuführen. Ich setze dazu einfach mal einen Link zu einer Erklärung von mir auf Stackoverflow:
https://stackoverflow.com/questions/...03508#58803508

Ich selbst habe das auf der Seite von Peter Haserodt gelernt:
Online - Excel Programmierung VBA Makro: Klassen [5] - Events [1] - Steuerelemente

Das ist ein Unterpunkt aus dem Thema Klassenprogrammierung:
Online - Excel Programmierung VBA Makro: Klassen

Viele Grüße,

Zwenn

edwinbastler · 28. Mai 2020

Folgenden Code incl. deiner Änderungen habe ich weitergebaut:

Userform1 Code:

Private msoTB() As clsTextBox
Private msoCB() As clsCommandButton
Private m_lngLetzteZeile As Long

Property Get lngLetzteZeile() As Long
If m_lngLetzteZeile = 0 Then
m_lngLetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End If
lngLetzteZeile = m_lngLetzteZeile
End Property

Private Sub Frame1_Click()

End Sub

'---------------------------------------
'Ereignisse der Userform
'---------------------------------------
Private Sub UserForm_Initialize()

ReDim msoTB(1 To lngLetzteZeile)
ReDim msoCB(1 To lngLetzteZeile)

Call TextBoxen1
Call TextBoxen2
Call TextBoxen3
Call VergleicheUndBunte2
Call CommandButton1

End Sub

'---------------------------------------
'Prozeduren
'---------------------------------------

Private Sub TextBoxen1()
Dim c As MSForms.TextBox
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set c = Me.Frame1.Controls.Add("Forms.TextBox.1", "TXT2" & S, True)

With c
.BackColor = &H80000002
.Locked = True
.Height = 15.75
.AutoSize = True

If .Width < 150 Then
.AutoSize = False
.Width = 190
End If

.Top = 5 + 18 * S
.Left = 12
.ControlSource = "A" & S

Set msoTB(S) = New clsTextBox
Set msoTB(S).TXT2 = c
End With

w = w + 20

Next S

Frame1.ScrollBars = fmScrollBarsVertical
Frame1.ScrollHeight = w + 5
End Sub
Private Sub TextBoxen2()
Dim c As MSForms.TextBox
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set c = Me.Frame1.Controls.Add("Forms.TextBox.1", "TXT" & S, True)

With c
.BackColor = &H80000002
.Locked = True
.Height = 15.75
.Width = 23
.Top = 5 + 18 * S
.Left = 170
.ControlSource = "B" & S

Set msoTB(S).TXT = c

End With

w = w + 20

Next S
End Sub

Private Sub TextBoxen3()
Dim c As MSForms.TextBox
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set c = Me.Frame1.Controls.Add("Forms.TextBox.1", "TXT1" & S, True)

With c
.BackColor = &H80000002
.Locked = True
.Height = 15.75
.AutoSize = True
If .Width < 20 Then
.AutoSize = False
.Width = 20
End If
.Top = 5 + 18 * S
.Left = 190
.ControlSource = "C" & S

Set msoTB(S).TXT1 = c

End With

w = w + 20

Next S
End Sub
Private Sub CommandButton1()
Dim CB As MSForms.CommandButton
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set CB = Me.Frame1.Controls.Add("Forms.CommandButton.1", "COB1" & S, True)

With CB
.BackColor = &H80000002
.Locked = False
.Height = 18
.Width = 80
.Font.Bold = True
.ForeColor = RGB(0, 128, 49)
.BackColor = RGB(179, 207, 230)

.Top = 5 + 18 * S
.Left = 220
.Caption = Range("A" & S).Text

Set msoCB(S) = New clsCommandButton
Set msoCB(S).COB1 = CB

End With

w = w + 20

Next S
End Sub

Private Sub VergleicheUndBunte()
Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)
If IsNumeric(msoTB(i).TXT1.Value) And IsNumeric(msoTB(i).TXT.Value) Then

Select Case True
Case CDbl(msoTB(i).TXT1.Value) > CDbl(msoTB(i).TXT.Value)
msoTB(i).TXT.BackColor = &H80000002
Case CDbl(msoTB(i).TXT1.Value) < CDbl(msoTB(i).TXT.Value)
msoTB(i).TXT.BackColor = RGB(255, 0, 0)
Case Else
msoTB(i).TXT.BackColor = RGB(255, 255, 255)
End Select

End If
Next i
End Sub

Private Sub VergleicheUndBunte1()
Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)

Select Case True
Case CDbl(msoTB(i).TXT1.Value) > CDbl(msoTB(i).TXT.Value)
msoTB(i).TXT.BackColor = &H80000002
msoTB(i).TXT1.BackColor = &H80000002
msoTB(i).TXT2.BackColor = &H80000002
Case CDbl(msoTB(i).TXT1.Value) < CDbl(msoTB(i).TXT.Value)
msoTB(i).TXT.BackColor = RGB(255, 0, 0)
msoTB(i).TXT1.BackColor = RGB(255, 0, 0)
msoTB(i).TXT2.BackColor = RGB(255, 0, 0)
Case Else
msoTB(i).TXT.BackColor = RGB(255, 255, 255)
msoTB(i).TXT1.BackColor = RGB(255, 255, 255)
msoTB(i).TXT2.BackColor = RGB(255, 255, 255)
End Select

Next i
End Sub

Private Sub VergleicheUndBunte2()
Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)

If CDbl(msoTB(i).TXT1.Value) - CDbl(msoTB(i).TXT.Value) < 0 Then
msoTB(i).TXT2.BackColor = vbRed
ElseIf CDbl(msoTB(i).TXT1.Value) - CDbl(msoTB(i).TXT.Value) < 10 Then
msoTB(i).TXT2.BackColor = vbYellow
Else
msoTB(i).TXT2.BackColor = vbGreen
End If

Next i
End Sub
Public Sub austesten()

Dim i As Long

For i = LBound(msoTB, 1) To UBound(msoTB, 1)

SuchBox1.Text = ""
SuchBox1 = msoTB(i).TXT2

Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klassenmodul: clsTextBox
Code:

Option Explicit

Public WithEvents TXT As MSForms.TextBox
Public WithEvents TXT1 As MSForms.TextBox
Public WithEvents TXT2 As MSForms.TextBox
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klassenmodul: clsCommandButton
Code:

Option Explicit

Public WithEvents COB1 As MSForms.CommandButton

Private Sub COB1_Click()
Call UserForm1.austesten
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was ich erreichen will ist, dass der Wert aus der linken Textbox "TXT2" mit dem Button in der selben Zeile in die Suchbox1 kopiert wird. Jeder Button ist den Textboxen TXT, TXT1, TXT2 einer Zeile zugeordnet.
Ich lade die Excel Datei gleich mit hoch. Vielen Dank für deine Mühe.

EarlFred · 28. Mai 2020

CodeModul Userform1
Es fehlt Option Explicit!
*entsetzt
Hinschreiben, bevor du auch nur einen Satz weiter liest!

Code:

Call TextBoxen1
Call TextBoxen2
Call TextBoxen3
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das habe ich dir schon kompakter geschrieben, siehe Post #16. Schau es dir bitte noch einmal an.

Neuer Code für clsCommandButton (komplett ersetzen)
Code:

Option Explicit

Public WithEvents COB1 As MSForms.CommandButton
Private m_ParentForm As UserForm1
Private m_tb As MSForms.TextBox

'Eltern-Userform
Public Property Set ParentForm(ByRef Param As UserForm1)
Set m_ParentForm = Param
End Property
Public Property Get ParentForm() As UserForm1
Set ParentForm = m_ParentForm
End Property

'Zugehörende TextBox:
Public Property Set TB(ByRef Param As MSForms.TextBox)
Set m_tb = Param
End Property
Public Property Get TB() As MSForms.TextBox
Set TB = m_tb
End Property

Private Sub COB1_Click()
m_ParentForm.Suchfeld.Value = m_tb.Value
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe nicht in die Datei geschaut, nehme aber wegen deines gezeigten Codes an, dass die Userform noch UserForm1 heißt. Wenn nicht, musst du das im vorstehenden Code anpassen!
(Einmal habe ich das rot markiert, den Rest findest du dann sicher auch)

In der Userform1 die Prozedur CommandButton1 ersetzen durch:
Code:

Private Sub CommandButtons( _
ByRef CBName As String, _
ByRef Breite As Long, _
ByRef links As Long)

Dim c As MSForms.CommandButton
Dim w As Long
Dim S As Long

w = 12

For S = 1 To lngLetzteZeile

Set c = Me.Frame1.Controls.Add("Forms.CommandButton.1", CBName & S, True)

With c
.BackColor = &H80000002
.Locked = False
.Height = 15.75
.Width = Breite
.Top = 5 + 18 * S
.Left = links
End With

Set msoCB(S) = New clsCommandButton
Set msoCB(S).COB1 = c
Set msoCB(S).TB = msoTB(S).TxT1
Set msoCB(S).ParentForm = Me

w = w + 20

Next S

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

In der Userform1, Prozedut UserForm_Initialize() folgende Codezeile ersetzen:
Call CommandButton1
durch
Code:

Call CommandButtons(CBName:="CB", Breite:=50, links:=260)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das ist optional, aber wenn du das nicht übernehmen willst, musst du meine Prozedur CommandButtons entsprechend anpassen!

Die Änderungen sind offensichtlich, dennoch ein paar Erläuterungen des Wieso und Warum:
In der Klasse clsCommandButton ist jetzt zu jedem Button die zugehörende Textbox bekannt. Das kann man auch so einfache Weise betreiben, da Textboxen und Buttons in 1:1-Beziehung stehen.
Du kannst jetzt innerhalb dieser Klasse auf diese Textbox zugreifen, weil sie dort "offiziell" bekannt ist.
Das gleiche gilt für die Userform, auf die ebenfalls eine Referenz hinterlegt wird. Du kannst nun also auf die Eigenschaften vollumfänglich zugreifen, also auch der Textbox Suchfeld einen Wert zuweisen, ohne auf externe Prozeduren einer anderen Klasse zugreifen zu müssen. Dadurch wird der Code zwar etwas speicherintensiver, aber bleibt stringent und überschaubar.

Der Codefetzen
Code:

Private Sub Frame1_Click()

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ist ohne Funktion und wurde einfach noch nicht gelöscht. Das kannst du ohne weiteres tun.

Ob das jetzt alles 100% kompatibel zu Deiner Mappe ist, habe ich nicht abschließend getestet. Es ging mir darum, dir dieses Konzept als Alternative vorzuschlagen. Ich bin mir sicher, etwaige Anpassungen bekommst du hin.

edwinbastler · 28. Mai 2020

Hallo EarlFred,

Tausend Dank. Das muss ich erst mal untersuchen.

Gruß Uwe

Office: Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben

Mit in Laufzeit erzeugten dynamischen Texboxen Werte vergleichen und einfärben - Similar Threads - Laufzeit erzeugten dynamischen

Power Query - Rücklaufkontrolle und Laufzeit berechnen

Maschinen laufzeit erechnen

lange Laufzeit beim Formatieren

USysRibbons verursacht Laufzeit-Fehler

USysRibbons verursacht Laufzeit-Fehler

Herunterladen und Installieren der Microsoft 365 Access-Laufzeit

Laufzeiten-Fehler