Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1840to1844
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1840to1844
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code Optimierung möglich?

Code Optimierung möglich?
10.08.2021 15:32:35
Sven1403
Moin an alle,
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: Userbild
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
Die einzelnen Labels mit MouseMove ansprechen geht leider nicht weil die unter dem LabelClickArea liegen.
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.
Vielleicht freut sich ja auch einer über diese Kalender Klasse, die ich gefunden habe. Finde das Ding sau geil :P
Danke im Voraus
Gruß Sven

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

Betreff
Datum
Anwender
Anzeige
AW: Code Optimierung möglich?
10.08.2021 16:18:35
Daniel
Hi
ich würde hier eine Schleife über die Steuerelemente machen und über die Position prüfen, ob das Steuerlement
a) unter der ClickArea liegt (die ClickArea muss die Steuerelemente vollständig überdecken)
b) unter dem Click-Punkt liegt
wenn a) gegeben ist wird entfärbt (aber nur, wenn das Label eine andere Farbe hat
wenn neben a) auch b) gegeben ist, wird das Label gefärbt.
da du das entfärben nur machst, wenn es notwendig ist, sollte hier kein Flackern auftreten.
über die Postionsprüfung musst du dann den Code auch nicht mehr anpassen, wenn du Labels änderst oder umbenennst.
wenn du dir hierbei auch gleich merkst, über welchem steuerelement sich der Cursor gerade befindet, könntest du dass dann auch gleich für den Klick übernehmen und müsstest dort nicht mehr ermitteln. Dann wäre es sogar möglich, unterschiedlich große Labels zu verwenden.

Dim crt As Control
With LabelClickArea
For Each crt In FrameCalendar.Controls
If crt.Top >= .Top And (crt.Top + crt.Height) = .Left And (crt.Left + crt.Width)  &HFFFFFF Then crt.BackColor = &HFFFFFF
If (crt.Top - .Top = Y And (crt.Left - .Left) = X Then
crt.BackColor = RGB(211, 240, 224)
end if
End If
Next
End With
Gruß Daniel
Anzeige
AW: Code Optimierung möglich?
11.08.2021 14:39:36
Sven1403
Hey eine super Lösung!
Flackern tut es trotzdem. Jedoch hab ich jetzt folgendes gemerkt: Ändere ich die Auflösungsskalierung meines Laptops auf 100%, flackert es nicht mehr (vorher 200%)
Hast du da evtl. eine Idee woran das liegt und ob man das irgendwie beheben kann? Wenn ich den Kalender ohne den Hover Effekt Code benutze, flackert es ja nicht auf 200% Auflösungsskalierung.

286 Forumthreads zu ähnlichen Themen

Beim Kopieren eines Tabellenblattes den VBA-Code e
Alfi

Hallo Excel-Gemeinde!
ich habe eine mehrblättrige Datei, per Makro kopiere ich ein Blatt und speichere dieses unter neuem Namen ab.
Dieses Blatt soll aber nicht mehr den VBA-Code der ursprübglichen Datei enthalten, sprich ein Blatt ohne Makros.
Wer kann mir helfen?
So sieht der...
09.09.2008 09:58:00
Thread-ID: 1008333
8 Beiträge
Anzeige
Array-Formel in VBA-Code umwandeln?
Robert

Hallo,
ich bräuchte bitte eure Hilfe.
Hab folgende Formel...
Selection.FormulaArray = _
=IF(ROW(R[-107]C[-3])>COUNTA('1'!R5C[4]:R200C[4]),"""",INDEX('1'!R5C4:R200C4,SMALL(IF('1'!R5C[4]:R200C[4]<>"""",ROW(R1:R196),""""),ROW(R[-107]C[-3]))))"
Mein Problem ist, dass ic...
26.10.2008 10:56:28
Thread-ID: 1019326
13 Beiträge
Code per VBA in "Diese Arbeitsmappe"
Timo

Hallo,
mir ist bekannt, wie ich per VBA ein neues Modul anlegen und eine Sub erzeugen kann.
Ich möchte nun aber per VBA eine sub in "Diese Arbeitsmappe" erzeugen und mit einer zweiten Prozedur wieder löschen.
Geht das?
Ich habe im Archiv nichts relevantes hierzu gefunden.
V...
29.10.2008 11:37:00
Thread-ID: 1020207
6 Beiträge
Anzeige
Zeilenumbruch bei Formel in VBA Code
Waven

Hallo Zusammen
Ist es irgendwie möglich im VBA Code innerhalb einer Formel einen Zeilenumbruch zu machen?
Als Beispiel:
aus
Range("A1").Formula = "=SUMPRODUCT((B23:B40=1)*(Q23:Q40=1)*(O23:O40))+SUMPRODUCT((B23:B40=1)*(Q23:Q401)*(R23:R40=1)*(O23:O40))"
soll sowas wie
Ran...
25.11.2008 12:08:00
Thread-ID: 1027662
3 Beiträge
Kleines VBA Code Problem
maxx_1985

Hi Leute
Beim Ausfuehren dieses Codes dauert es eine Ewigkeit bis Excel fertig ist. Und es ruckelt ebenso ne Ewigkeit. Wie kann man das anders loesen? hat jemand ne idee?
danke
Sub Step2() 'delete zeros Dim i As Long For i = Cells(Rows.Count, 9).End(xlUp).Row To 1 Step -1 If Cells...
26.11.2008 20:42:00
Thread-ID: 1028150
8 Beiträge
Brainfuck Code umsetzen in Vba-Code
Reinhard

Hallo Wissende, Brainfuck Code sieht so aus: >++++++++++[-]++++++[-].>++[-].>+++[-]+++[-]+++[-].>++[-].>++++[-]++++ usw. Wobei nur diese acht Regeln gelten: > Inkrementiert den Zellzeiger, quasi Activecell.offset(0,1) http://de.wikipedia.org/wiki/Brainfuck _ In dieser Mapp...
25.12.2008 18:17:00
Thread-ID: 1035219
7 Beiträge
Kleines VBA Code Problem
maxx_1985

Hi
Warum loescht mir Excel hier nur die ersten zwei Zeilen? Hat jemand eine Idee?
Danke!
Sub step9() Dim i, lz As Long lz = Cells(Rows.Count, 6).End(xlUp).Row For i = 1 To lz If Cells(i, 6) = "" Then Exit For End If Next i Range("A2", Cells(i - 1, 43)).Select Selection.SpecialCell...
16.01.2009 19:35:01
Thread-ID: 1040733
3 Beiträge
VBA > Text keinen Zeilenumbruch
Gopla

Hallo liebe Gemeinschaft,
ich habe ein Problem, dessen ich nicht Herr werde und welches schwer zu beschreiben ist:
Ich habe einen Text.txt, welcher in VBA durch
intHandle = FreeFile
Open "C:\test.txt" For Input As #intHandle
geöffnet wird und anschließend durch
Line In...
18.01.2009 01:55:08
Thread-ID: 1041037
6 Beiträge
Anzeige

Links zu Excel-Dialogen

TextBox UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
7
4
12
5
12
2
7
6
2
5
2
23
7
4
2
4
3
6
3
4
1
10
4
7
1