Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code kürzen

Code kürzen
15.07.2014 12:08:05
Andreas

Hallo Excelprofis,
Ich habe ein UserForm mit ca. 350 Textboxen. Dank dieses super Forums und Internetrecherche kann ich jede Textbox durch Doppelklick "markieren" (färbt sich grün). Per Commandbuttons werden nur die Werte der "markierten" Textboxen in bestimmte Zellen eingetragen. Der Code sieht folgendermaßen aus:


Private Sub CommandButton5_Click()
Dim tbxCtrl As Object
Dim iX As Integer
Dim lRow As Long
Sheets("Benutzer").Visible = True
Sheets("Benutzer").Select
Sheets("Benutzer").Range("A1").Value = Me.TextBox400.Text
Sheets("Benutzer").Range("a2:a17").ClearContents
lRow = 2
For iX = 1 To 16
Set tbxCtrl = Me.Controls("TextBox" & iX)
If tbxCtrl.BackColor = &HC0FFC0 Then
Cells(lRow, 1) = Replace(tbxCtrl.Text, vbCrLf, vbLf)
lRow = lRow + 1
End If
Next iX
End Sub
Private Sub CommandButton6_Click()
Dim tbxCtrl As Object
Dim iX As Integer
Dim lRow As Long
Sheets("Benutzer").Visible = True
Sheets("Benutzer").Select
Sheets("Benutzer").Range("B1").Value = Me.TextBox401.Text
Sheets("Benutzer").Range("b2:b17").ClearContents
lRow = 2
For iX = 17 To 32
Set tbxCtrl = Me.Controls("TextBox" & iX)
If tbxCtrl.BackColor = &HC0FFC0 Then
Cells(lRow, 2) = Replace(tbxCtrl.Text, vbCrLf, vbLf)
lRow = lRow + 1
End If
Next iX
End Sub
usw. bis Commandbutton 25

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
switchcolor TextBox1
End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
switchcolor TextBox2
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
switchcolor TextBox3
End Sub
Private Sub TextBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
switchcolor TextBox4
End Sub

usw. soll bis Textbox 336 gehen

Sub switchcolor(ByRef tbxCtrl As MSForms.TextBox)
If tbxCtrl.BackColor = &H80000005 Then
tbxCtrl.BackColor = &HC0FFC0
Else
tbxCtrl.BackColor = &H80000005
End If
End Sub

Meine Frage: Kann man den Code für die Textboxen 1 bis 336 irgendwie zusammenfassen?
Danke fürs Lesen und die Hilfe!
mfg, Andreas

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code kürzen
15.07.2014 12:24:55
Nepumuk
Hallo,
schon mal eine Klasse programmiert? Damit geht das.
Sind wirklich alle TextBoxen auf dem Userform davon betroffen oder gibt es Ausnahmen welche nicht reagieren sollen?
Gruß
Nepumuk

AW: Code kürzen
15.07.2014 12:30:48
Andreas
Hallo Nepumuk,
Danke für die Antwort. Bin leider nicht so bewandert in VBA. Kann mir zwar schon einiges zusammenreimen, wenn ich den Code sehe, aber selbst erstellen nicht.
Es sollen nur die Textboxen 1 bis 336 angesprochen werden.
mfg,Andreas

AW: Code kürzen
15.07.2014 12:41:58
Hajo_Zi
Hallo Andreas,
ein umfangreiches Beispiel zu Klasse.
http://hajo-excel.de/chCounter3/getfile.php?id=112
Beachte auch den Einsatz der Tag Eigenschaft.
Gruß Hajo

Anzeige
AW: Code kürzen
15.07.2014 12:48:33
Nepumuk
Hallo,
im VBA-Editor - Menüleiste - Einfügen - Klassenmodul. Links unten im Eigenschaftsfenster den Namen des neuen Klassenmoduls von "Klasse1" auf "clsTextBox" ändern. In dieses Klassenmodul kommt folgender Code:
' **********************************************************************
' Modul: clsTextBox Typ: Klassenmodul
' **********************************************************************

Option Explicit

Private WithEvents mobjTextBox As MSForms.TextBox

Private Sub Class_Terminate()
    Set TextBox = Nothing
End Sub

Private Property Get TextBox() As MSForms.TextBox
    Set TextBox = mobjTextBox
End Property

Friend Property Set TextBox(ByRef probjTextBox As MSForms.TextBox)
    Set mobjTextBox = probjTextBox
End Property

Private Sub mobjTextBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With TextBox
        If .BackColor = &H80000005 Then
            .BackColor = &HC0FFC0
        Else
            .BackColor = &H80000005
        End If
    End With
End Sub

In das Modul deines Userforms kommt folgender Code:
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private lobjTextBoxClassCollection As Collection

Private Sub UserForm_Activate()
    Dim lngIndex As Long
    Dim objTextBoxClass As clsTextBox
    Set lobjTextBoxClassCollection = New Collection
    For lngIndex = 1 To 336
        Set objTextBoxClass = New clsTextBox
        Set objTextBoxClass.TextBox = Controls("TextBox" & CStr(lngIndex))
        lobjTextBoxClassCollection.Add objTextBoxClass
        Set objTextBoxClass = Nothing
    Next
End Sub

Private Sub UserForm_Terminate()
    Set lobjTextBoxClassCollection = Nothing
End Sub

Das war's. ;-)
Gruß
Nepumuk

Anzeige
AW: Code kürzen
15.07.2014 13:29:26
Andreas
Hallo Nepumuk,
das ist ja super, Danke für die Hilfe und Mühe.
Ne schöne Woche noch!
mfg, Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige