Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Animation VBA-Optimierung
#1
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  Angel

LG Andre

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


Angehängte Dateien
.xlsm   Animation.xlsm (Größe: 18,43 KB / Downloads: 9)
Antwortento top
#2
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
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • Andrek
Antwortento top
#3
Hallo Karl-Heinz,

vielen herzlichen Dank! Funktioniert einwandfrei!  28

LG Andre

P.S.: Ein Problem ist gelöst  23
Antwortento top
#4
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
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • Andrek
Antwortento top
#5
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..  Angel

LG
Andre
Antwortento top
#6
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
Antwortento top
#7
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!  Angel

LG Andre
Antwortento top
#8
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
'...
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
  • Andrek
Antwortento top
#9
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
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • Andrek
Antwortento top
#10
Leute, vielen Dank euch!   100

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

Vielen herzlichen Dank!

LG Andre
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste