Animation VBA-Optimierung

[Andrek]

Hallo,

ich habe eine Animation Makro - die einen Element/Bild bewegen tut. Sowas habe ich für mein kleines Projekt gesucht/gebraucht.

Code:

Sub animation()
    Randomize
   
    For j = 1 To [F3].Value
      ActiveSheet.Shapes("Bild").Select
      m = 200
      For i = 1 To 190
        Selection.ShapeRange.Top = m
        m = m - 1
        DoEvents
    Next i
   
    For i = 1 To 190
        Selection.ShapeRange.Top = m
        m = m + 1
        DoEvents
      Next i
    Next j
   [F3].Select
   
End Sub

Ich brauche eure Hilfe zum optimieren:  :23:

1) wie kann ich die Bewegungsgeschwindigkeit einstellen => in meinem Fall möchte ich das mein Objekt langsamer bewegt wird.

2) mit START ist klar, aber mit welcher Funktion kann ich die Bewegung(Makro) vorzeitig beenden. Wenn beim start 10 Runden eingestellt waren, aber dann doch nach 5 Runden möchte ich das Bild stoppen.

Ich bin kein VBA-Profi, bin erst am Anfang 

LG Andre

P.S.: ein Beispieldatei habe ich dazugefügt

[volti]

Hallo Andre,

zum "Bremsen" Deiner Abläufe im Millisekundenbereich kannst Du z.B. die Sleep-Sub nehmen.

Code:

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub animation()
    Randomize
    
    For j = 1 To [F3].Value
      ActiveSheet.Shapes("Bild").Select
      m = 200
      For i = 1 To 190
        Sleep 20
        Selection.ShapeRange.Top = m
        m = m - 1
        DoEvents
    Next i
    
    For i = 1 To 190
        Selection.ShapeRange.Top = m
        Sleep 20
        m = m + 1
        DoEvents
      Next i
    Next j
   [F3].Select
    
End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz

[Andrek]

Hallo Karl-Heinz,

vielen herzlichen Dank! Funktioniert einwandfrei!  :28:

LG Andre

P.S.: Ein Problem ist gelöst  :23:

[volti]

Und hier der zweite Teil...

Code:

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Const cbAbbruch = 5
Const ciCancelKey  As Long = 27
Public gbAbbruch As Integer

Sub animation()
    gbAbbruch = 0
    Randomize
    
    For j = 1 To [F3].Value
      ActiveSheet.Shapes("Bild").Select
      m = 200
      For i = 1 To 190
        Sleep 20
        Selection.ShapeRange.Top = m
        m = m - 1
        DoEvents
        If AskForCancel() = cbAbbruch Then GoTo Schluss
    Next i
    
    For i = 1 To 190
        Selection.ShapeRange.Top = m
        Sleep 20
        m = m + 1
        DoEvents
        If AskForCancel() = cbAbbruch Then GoTo Schluss
      Next i
    Next j
Schluss:
   [F3].Select
    
End Sub

Function AskForCancel()
'Funktion fragt nach Betätigung der Abbruchtaste noch mal nach
 If GetAsyncKeyState(ciCancelKey) <> 0 Then
    AskForCancel = cbAbbruch: gbAbbruch = cbAbbruch
 End If
End Function

______________________
viele Grüße aus Freigericht
Karl-Heinz

[Andrek]

Karl-Heinz, 

jetzt stolpere jetzt einbißchen: wie führe ich jetzt die Funktion AskForCancel() aus das meine Bewegung ohne Alarm und am besten ohne vorige Abfrage unterbrochen wird? 

Noch besser wäre, wenn ich über ein Button z.B. Sub stop()  die Animation sofort stoppen kann.. 

LG
Andre

[volti]

Hallo,
Du führst die Funktion gar nicht aus, sie wird ja aus Deinem Makro aufgerufen. Dort wird die ESC-Taste abgefragt und wenn Du die gedrückt hast, wird Dein Makro beendet.
Wenn eine Sub läuft, kannst Du keine andere z.B. Sub Stop ausführen.
VG KH

[Andrek]

Ok, über "ESC" funktioniert das, aber das ist nicht genau wie ich es wollte. 

Ich versuch nochmal zu erklären(bißchen genauer) ich werde 3-4 verschiedene(gleiche von Aufbau) Animationen haben wo ich jede Animationen per Start starte - so weit ist alles OK, 3 x START Makro(Nr1, Nr.2, Nr.3) .. Aber jetzt möchte ich z.B. die Animation Nr.2 stoppen, so das die andere 2 weiterlaufen! Dafür brauche bei jede Animation einem STOP-Button. 

es werden in Wirklichkeit 3 Filter die ich jeden einzeln per Button EIN- und AUS-schalten kann und eine Animation wird mir dann die Filtrierung optisch darstellen.

Hoffentlich ist jetzt mein Vorhaben bißchen deutlicher geworden! 

LG Andre

[schauan]

Hallöchen,

wenn es bei den Buttons bleiben soll könntest Du z.B. 3 Public-Variablen deklarieren und bei Betätigung eines Buttons die jeweils zugehörige auf true setzen oder ins Gegenteil verkehren. Im Makro fragst Du den Status ab und brichst bei true ab.
Das wäre dann oben drüber

Public bolBtn1 as Boolean, bolBtn2 as Boolean, bolBtn3 as Boolean

Im Button-Click-Makro z.B. des ersten Buttons

'...
bolBtn1 = not bolBtn1 'verkehrt ins Gegenteil
'...

Im Makro dann z.B. beim ersten Bild

'...
If bolBtn1 = False Then
'Animation 1
End If
'...

[volti]

Hallo,

ordne einem Stop-Button das Stoppen-Makro zu.
Dann sollte es gehen.

Code:

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const cbAbbruch = 5
Public gbAbbruch As Integer

Sub Stoppen()
    gbAbbruch = cbAbbruch
End Sub

Sub animation()
    gbAbbruch = 0
    Randomize
    
    For j = 1 To [F3].Value
      ActiveSheet.Shapes("Bild").Select
      m = 200
      For i = 1 To 190
        Sleep 20
        Selection.ShapeRange.Top = m
        m = m - 1
        DoEvents
        If gbAbbruch = cbAbbruch Then GoTo Schluss
    Next i
    
    For i = 1 To 190
        Selection.ShapeRange.Top = m
        Sleep 20
        m = m + 1
        DoEvents
        If gbAbbruch = cbAbbruch Then GoTo Schluss
      Next i
    Next j
Schluss:
   [F3].Select
    
End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz

[Andrek]

Leute, vielen Dank euch!   :100:

Funktioniert wie ich wollte => beide Punkte/Aufgaben sind gelöst!  :23:

Vielen herzlichen Dank!

LG Andre