Code Optimierung möglich?
10.08.2021 16:00:57
Sven1403
ich bin momentan dabei ein UserForm zu erstellen was eine einfach Eingabe ermöglicht. Der Nutzer soll Datumseingaben machen. Ich habe da was nettes gefunden. Jemand hat eine Klasse erstellt die ein Kalender enthält (damit spart man sich das Steuerelement was es gibt -> Grund: hier im Unternehmen ist das nicht standardmäßig installiert). Das hab ich nun so integriert, dass der Nutzer auf ein Textfeld im UserForm klickt, sich ein neues Form öffnet mit dem besagten Kalender. Siehe hier:
Klickt man nun ein Datum an wird das in das Textfeld im Screenshot eingetragen und mit Übernehmen an das Haupt Formular geschickt und da in die Ursprungs Textbox eingetragen.
Das zur Funktion.
Ich wollte das nun so nutzerfreundlich machen, dass der Nutzer sieht was er da im Kalender anklickt. Also ein einfacherer Hover Effekt. Ich musste mich da natürlich an die Kalender Klasse anpassen. Habe auch rausgefunden wie es funktioniert. Bloß nun flackert der Kalender wenn man zwischen den Labels entlang geht. Hier mal die Datei mit der Kalender Klasse: https://www.herber.de/bbs/user/147536.xls
Ich probiere es mal mit eigenen Worten zu erklären: Der Kalender besteht aus ganz vielen Labels mit einen großen sogenannten LabelClickArea. In diesem LabelClickArea kann man anhand der X/Y Koordinate die Reihe und Spalte rausfinden wo reingeklickt wird. Das wird hiermit gemacht:
intRow = sngY / 12 + 0.5
intCol = sngX / 12 + 0.5
Funktioniert auch alles perfekt.
Mein Ansatz war dann ein ziemlicher statischer, wo ich händisch alle möglichen Treffer definiert habe. Da hat es dann schon geflackert. Dachte wenn ich den Code mit Select Case verringere wird es besser. Wird es auch, ABER der Hover Effekt ist fehlerhaft... Hier noch einmal die Kalender Datei mit dem Fehler: https://www.herber.de/bbs/user/147537.xls
Einfach den Kalender über den Button öffnen und mit der Maus mal rumspielen. Mein Code ist im UserForm unter Private Sub LabelClickArea_MouseMove
Poste den auch nochmal hier:
Private Sub LabelClickArea_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
clsCal.CaptureClick
Cancel = True
End Sub
Private Sub LabelClickArea_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim intRow As Integer
Dim intCol As Integer
intRow = Y / 12 + 0.5
intCol = X / 12 + 0.5
Select Case intRow
Case 3
If intCol = 1 Then Label1.BackColor = RGB(211, 240, 224) Else Label1.BackColor = &HFFFFFF
If intCol = 2 Then Label2.BackColor = RGB(211, 240, 224) Else Label2.BackColor = &HFFFFFF
If intCol = 3 Then Label3.BackColor = RGB(211, 240, 224) Else Label3.BackColor = &HFFFFFF
If intCol = 4 Then Label4.BackColor = RGB(211, 240, 224) Else Label4.BackColor = &HFFFFFF
If intCol = 5 Then Label5.BackColor = RGB(211, 240, 224) Else Label5.BackColor = &HFFFFFF
If intCol = 6 Then Label6.BackColor = RGB(211, 240, 224) Else Label6.BackColor = &HFFFFFF
If intCol = 7 Then Label7.BackColor = RGB(211, 240, 224) Else Label7.BackColor = &HFFFFFF
Case 4
If intCol = 1 Then Label8.BackColor = RGB(211, 240, 224) Else Label8.BackColor = &HFFFFFF
If intCol = 2 Then Label9.BackColor = RGB(211, 240, 224) Else Label9.BackColor = &HFFFFFF
If intCol = 3 Then Label10.BackColor = RGB(211, 240, 224) Else Label10.BackColor = &HFFFFFF
If intCol = 4 Then Label11.BackColor = RGB(211, 240, 224) Else Label11.BackColor = &HFFFFFF
If intCol = 5 Then Label12.BackColor = RGB(211, 240, 224) Else Label12.BackColor = &HFFFFFF
If intCol = 6 Then Label13.BackColor = RGB(211, 240, 224) Else Label13.BackColor = &HFFFFFF
If intCol = 7 Then Label14.BackColor = RGB(211, 240, 224) Else Label14.BackColor = &HFFFFFF
Case 5
If intCol = 1 Then Label15.BackColor = RGB(211, 240, 224) Else Label15.BackColor = &HFFFFFF
If intCol = 2 Then Label16.BackColor = RGB(211, 240, 224) Else Label16.BackColor = &HFFFFFF
If intCol = 3 Then Label17.BackColor = RGB(211, 240, 224) Else Label17.BackColor = &HFFFFFF
If intCol = 4 Then Label18.BackColor = RGB(211, 240, 224) Else Label18.BackColor = &HFFFFFF
If intCol = 5 Then Label19.BackColor = RGB(211, 240, 224) Else Label19.BackColor = &HFFFFFF
If intCol = 6 Then Label20.BackColor = RGB(211, 240, 224) Else Label20.BackColor = &HFFFFFF
If intCol = 7 Then Label21.BackColor = RGB(211, 240, 224) Else Label21.BackColor = &HFFFFFF
Case 6
If intCol = 1 Then Label22.BackColor = RGB(211, 240, 224) Else Label22.BackColor = &HFFFFFF
If intCol = 2 Then Label23.BackColor = RGB(211, 240, 224) Else Label23.BackColor = &HFFFFFF
If intCol = 3 Then Label24.BackColor = RGB(211, 240, 224) Else Label24.BackColor = &HFFFFFF
If intCol = 4 Then Label25.BackColor = RGB(211, 240, 224) Else Label25.BackColor = &HFFFFFF
If intCol = 5 Then Label26.BackColor = RGB(211, 240, 224) Else Label26.BackColor = &HFFFFFF
If intCol = 6 Then Label27.BackColor = RGB(211, 240, 224) Else Label27.BackColor = &HFFFFFF
If intCol = 7 Then Label28.BackColor = RGB(211, 240, 224) Else Label28.BackColor = &HFFFFFF
Case 7
If intCol = 1 Then Label29.BackColor = RGB(211, 240, 224) Else Label29.BackColor = &HFFFFFF
If intCol = 2 Then Label30.BackColor = RGB(211, 240, 224) Else Label30.BackColor = &HFFFFFF
If intCol = 3 Then Label31.BackColor = RGB(211, 240, 224) Else Label31.BackColor = &HFFFFFF
If intCol = 4 Then Label32.BackColor = RGB(211, 240, 224) Else Label32.BackColor = &HFFFFFF
If intCol = 5 Then Label33.BackColor = RGB(211, 240, 224) Else Label33.BackColor = &HFFFFFF
If intCol = 6 Then Label34.BackColor = RGB(211, 240, 224) Else Label34.BackColor = &HFFFFFF
If intCol = 7 Then Label35.BackColor = RGB(211, 240, 224) Else Label35.BackColor = &HFFFFFF
Case 8
If intCol = 1 Then Label36.BackColor = RGB(211, 240, 224) Else Label36.BackColor = &HFFFFFF
If intCol = 2 Then Label37.BackColor = RGB(211, 240, 224) Else Label37.BackColor = &HFFFFFF
If intCol = 3 Then Label38.BackColor = RGB(211, 240, 224) Else Label38.BackColor = &HFFFFFF
If intCol = 4 Then Label39.BackColor = RGB(211, 240, 224) Else Label39.BackColor = &HFFFFFF
If intCol = 5 Then Label40.BackColor = RGB(211, 240, 224) Else Label40.BackColor = &HFFFFFF
If intCol = 6 Then Label41.BackColor = RGB(211, 240, 224) Else Label41.BackColor = &HFFFFFF
If intCol = 7 Then Label42.BackColor = RGB(211, 240, 224) Else Label42.BackColor = &HFFFFFF
End Select
With clsCal
.sngX = X
.sngY = Y
End With
End Sub
Falls einer eine Idee hat wie man den Fehler im oben stehenden Code beheben kann damit es richtig läuft oder eine Methode hat wo es auch läuft wäre ich sehr dankbar :)
Flackern tut es übrigens wenn ich die intRow Cases nicht nehme und dann wirklich alles statisch hinschreibe. Beispiel:
If intRow = 1 And intCol = 1 Then Label1.BackColor = usw.
Danke im Voraus
Gruß Sven
