Screen-Cursor-Steuerung

Hallo,
teilweise gehören in einer Tabelle die Daten zweier Spalten und zweier Zeilen immer zusammen.
Idee war jetzt, in diesem Bereich mit Buttons und entsprechender Schrittweite 'navigieren' zu können. Die Buttons sollen Richtungspfeile haben und nicht größer als 18x19 Pixel sein. - Da ich diese Größe mit Command-Buttons nicht umsetzen konnte, habe ich Excel-Pfeile als Meta-File in 'Picture' eingefügt. -
Sieht etwa aus wie beabsichtigt, aber der 'Bild-Button' soll animiert sein: Für die Dauer des Click die Farbe ändern und über .SpecialEffect einsinken.
Im angehängten Beispiel klappt dies leider erst beim Loslassen der Maustaste und muss nach Application.Wait wieder zurückgesetzt werden.
Weiterhin gefällt mir der Spagetti-Code "UserForm1.Image1. ...4 natürlich überhaupt nicht.
Sieht da jemand von euch eine bessere Lösung? - Gruß Nick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
das könntest du über die MouseDown- und MouseUp-Events der Image-Controls steueren.
bzw normale Makros, die aber nur für die userform gültig sind, kannst du auch direkt ins Modul der Userform schreiben:


Option Explicit
Dim FarbeAlt As Long
Private Sub Gedrückt(crt As Control)
FarbeAlt = crt.BackColor
crt.BackColor = vbRed
crt.SpecialEffect = 2
End Sub
Private Sub Losgelassen(crt As Control)
Dim z As Long, s As Long
crt.BackColor = FarbeAlt
crt.SpecialEffect = 0
z = ActiveCell.Row
s = ActiveCell.Column
Select Case crt.Name
Case "Image1": s = s - 2
Case "Image2": z = z + 2
Case "Image3": s = s + 2
Case "Image4": z = z - 2
End Select
z = WorksheetFunction.Max(1, z)
z = WorksheetFunction.Min(Rows.Count - 1, z)
s = WorksheetFunction.Max(1, s)
s = WorksheetFunction.Min(31, s)
Cells(z, s).Resize(2, 2).Select
End Sub
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
Call Gedrückt(Image1)
End Sub
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,  _
ByVal Y As Single)
Call Losgelassen(Image1)
End Sub
Private Sub Image2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
Call Gedrückt(Image2)
End Sub
Private Sub Image2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,  _
ByVal Y As Single)
Call Losgelassen(Image2)
End Sub
Private Sub Image3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
Call Gedrückt(Image3)
End Sub
Private Sub Image3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,  _
ByVal Y As Single)
Call Losgelassen(Image3)
End Sub
Private Sub Image4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
Call Gedrückt(Image4)
End Sub
Private Sub Image4_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,  _
ByVal Y As Single)
Call Losgelassen(Image4)
End Sub

gruß Daniel

Private Sub CursorVerschieben(crt As Control) Dim zeile As Long, spalte As Long Dim t As Double t = Timer + 0.7 'verzögerung für erste wiederholung Do Until Beenden zeile = ActiveCell.Row spalte = ActiveCell.Column Do DoEvents 'prüfen, ob mouseup ausgeführt wurde Loop While Timer

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Screen-Cursor-Steuerung

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread