Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
1244to1248
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

80x MouseDown Ereignis verringern

80x MouseDown Ereignis verringern
Dieterlem
Hallo Excelfreunde,
Ich habe mir eine Userform gebastelt, in der ich 80 Textboxen (tbo1-80) habe. Ich verwende/mißbrauche diese als Checkbox, da sie von der größe veränderbar sind und ich ihre Hintergrundfarbe ändern kann.
Die Hintergrundfarbe soll sich per Mausklick ändern lassen. Dafür verwende ich folgenden Code:
Private Sub tbo80_MouseDown(ByVal Button As Integer, usw...)
With tbo80
If .Value = "" then Exit Sub
If .BackColor = &HFFFFFF Then
.BackColor´= &HFFFF80
ElseIf .BackColor´= &HFFFF80 then
.BackColor = &HFFFFFF
End If
End With
End Sub
Es funktioniert zwar auch so wie es soll, jedoch müsste ich diesen Code 80x schreiben. Das geht zwar mit Copy and Paste schnell, doch ist das bestimmt nicht die beste Lösung. Ich möchte nicht nur das es funktioniert, sondern suche ich eine elegante Lösung.
Kann man das irgendwie zusammenfassen?
Kann man das verkürzen?
Danke schon mal im vorraus für eure Ideen und Antworten
Gruß
Dieterlem

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: 80x MouseDown Ereignis verringern
09.01.2012 10:29:35
Rudi
Hallo,
das geht über eine eigene Klasse für die Textboxen.
1. Neues Klassenmodul 'clsTxtBox'
Option Explicit
Public WithEvents myTxtBox As MSForms.TextBox
Private Sub myTxtBox_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With myTxtBox
If .Value = "" Then Exit Sub
If .BackColor = &HFFFFFF Then
.BackColor = &HFFFF80
ElseIf .BackColor = &HFFFF80 Then
.BackColor = &HFFFFFF
End If
End With
End Sub

Im Code der UF:
Option Explicit
Dim objTxtBox(1 To 80) As New clsTxtBox
Private Sub UserForm_Activate()
Dim i As Integer
For i = 1 To 80
Set objTxtBox(i).myTxtBox = Me.Controls("tbo" & i)
Next
End Sub

Gruß
Rudi
Anzeige
Danke Rudi, du bist super OWT
09.01.2012 10:41:32
Dieterlem

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige