Office: (Office 2019) Klassenmodul.Eigenschaften

Moin allerseits,

als erste Versuche in der Klassenprogrammierung habe ich mir zwei Controls gebastelt, die in einer Userform anhand ihrer Caption und Select Case verschiedene Prozeduren auslösen. Aktiv sind das CommandButtons, die dann in Textboxen schreiben bzw. diese formatieren. Das funktioniert schon wunderbar.

Width, Height, Top, Left usw. kann ich darüber erfolgreich definieren. Was mir nicht gelingen will, sind den CommandButtons ControlToolTips hinzuzufügen. Die cmds sind nur mit einer Abkürzung beschriftet, die ich per MouseOver gerne auflösen würde.

Anmerkung: Ich habe diese Frage auch in einem anderen Forum gestellt, bin hier also mit einem CrossPosting (igittigitt!). Man möge mir bitte verzeihen, denn auch nach drei Tagen habe ich dort leider keine Antwort erhalten.

Freue mich über jede Idee. Lieben Dank!

d'r Bastler

 

Na dann versuche ich mal mit der Vorstellung meines Codes. Vielleicht erleichtert das die Sache ein wenig.

Als Userform nehme ich eine VBA-Standardform, in deren Eigenschaften ich lediglich den Namen geändert habe: usfMain.
Alle darin enthaltenen TextBoxen und CommandButtons werden anhand zweier Tabellen dynamisch erzeugt. Hier der wesentliche Code:

Code:

Option Explicit
Dim btnCollection As New Collection
Dim tbxCollection As New Collection

Private Sub UserForm_Initialize()
System
Dim ctr As Control
Dim btnClass As clsButton, cmd As MSForms.CommandButton
Dim tbxClass As clsTextbox, tbx As MSForms.TextBox

Dim i As Integer, iDist As Integer, iTop As Integer, iLine As Integer, iRGB As Integer
Dim iLen As Integer, iCat As Integer
Dim sCat As String, sCap As String

iLen = WorksheetFunction.Max(wsW.Columns(6))
iCat = WorksheetFunction.CountA(wsK.Columns(1))

'usfDimensionen
Height = 200
Width = iCat * 30 + 78      'bestimmt die flexible Breite der USF in
Caption = "Dynamisch erzeugte UserForm"

'Anzahl, Größe und Position der cmd mit Caption
For i = 1 To iCat
sCat = wsK.Cells(i, 2)
Set cmd = Me.Controls.Add("Forms.CommandButton.1", "cmd" & sCat, True)
    sCat = wsK.Cells(i, 2)
   
    With cmd
        .Height = 20
        .Top = 10
        .Left = 30 * i
        .Width = 28
        .Caption = sCat
        .Enabled = True
    End With
   
    Set btnClass = New clsButton
    Set btnClass.cButton = cmd
    btnCollection.Add btnClass
Next i

' lblCatLong
Set ctr = Me.Controls.Add("Forms.Label.1", "lblCatLong", True)
With ctr
    .Height = 20
    .Width = Me.Width * 0.8
    .Top = 40
    .Left = Me.Width * 0.1
    .TextAlign = fmTextAlignCenter
    .Caption = "Bitte eine Kategorie wählen"
End With

In den Klassenmodulen ist eine clsButton definiert, die auf eine Prozedur Categories in einem allg. Modul verweist.

Code:

Option Explicit

Public WithEvents cButton As MSForms.CommandButton

Private Sub cButton_Click()
   
    Application.Run "Categorie", cButton.Caption

End Sub

Als Parameter und zur Entscheidung, welche Prozedur in der Sub Categories ausgeführt werden soll, wird die Caption des Buttons mitgegeben. >> Funktioniert soweit bestens.

Z.B. kann ich so mit dem Click-Event ein Label mit der vollständigen Beschriftung anzeigen lassen. Nachdem dieser Event aber auch noch andere Folgen hat, möchte ich dem Benutzer vor dem Click die Auflösung der Abkürzung als ToolTipp zeigen.

Im Allgemeinen Modul sieht der Code so aus:

Code:

Sub Categorie(sCat As String)
System
Dim i As Integer, a As Integer, r As Integer, rC As Integer, iRand As Integer, iLenMax As Integer
Dim sVal As String, sWord As String, sCatLong As String, sCtr As String
Dim ctr As Control

' Andere Buttons?
For i = 0 To UBound(aCMD)
    If sCat = aCMD(i) Then
        Application.Run "Characters", sCat
        Exit Sub
    End If
Next i

' KategorienZaehler
r = wsW.UsedRange.Rows.Count

With wsW
    For i = 1 To r
        sVal = .Cells(i, 2)
        If sVal = sCat Then
            a = a + 1
        End If
    Next i

'Kategorie extrahieren
    wsC.Cells.Clear
    rC = wsC.UsedRange.Rows.Count
        For i = 1 To r
            sVal = .Cells(i, 2)
            If sVal = sCat Then
                wsC.Cells(rC, 1) = .Cells(i, 1)
                rC = rC + 1
            End If
        Next i
End With

Der Code geht natürlich noch eine Weile weiter (für hier aber irrelevant), aber vielleicht hilft das bisher gezeigte zu einer Lösung mit dem ControlToolTip.

Besten Dank und schönen Abend noch!

 

Yaeh man yeah!! Konnte es selber lösen.