Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

80x MouseDown Ereignis verringern | Herbers Excel-Forum


Betrifft: 80x MouseDown Ereignis verringern von: Dieterlem
Geschrieben am: 09.01.2012 09:48:00

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

  

Betrifft: AW: 80x MouseDown Ereignis verringern von: Rudi Maintaire
Geschrieben am: 09.01.2012 10:29:35

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


  

Betrifft: Danke Rudi, du bist super OWT von: Dieterlem
Geschrieben am: 09.01.2012 10:41:32




Beiträge aus den Excel-Beispielen zum Thema "80x MouseDown Ereignis verringern"