Animation VBA-Optimierung

[snb]

Warum so ineffizient ?

[Andrek]

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

Hallo zusammen.

ich muss mich entschuldigen, aber mir sind noch paar Sachen aufgefallen:

1) START/STOP-Buttons funktionieren wunderbar, ABER ich darf nirgendswo draufdrucken, keine beliebige Zelle anwählen während das Makro läuft, sonst bekomme ich sofort Fehler(Screenshoot hänge als Anhang)?!? 

mehr Schönheitsfehler:
2) während das Makro läuft ist mein Bild angewählt, der entsprechend eine Rahme um sich bringt(siehe Anhang)  

__________________________________________________________

Code:

ActiveSheet.Shapes("Bild").Select
      m = 200
      For i = 1 To 190
        Sleep 20
        Selection.ShapeRange.Top = m

3) in diesen Bereich: mit m=200 tue ich die Startposition bestimmen. Durch verändern disen Wert kann ich die Position im vertikalen Bereich(von obere Kante) verändern.. Ist das möglich das mein Startposition ist genau die wie das Bild platziert ist und nicht die 200???

Ich danke euch vielmals für eure Mühe!  :23:

LG Andre

[volti]

Hallo Andre,

versuche es mal so:

Code:

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

Public gbAbbruch As Integer

Sub Stoppen()
    gbAbbruch = True
End Sub

Sub animation()
 Dim iOffset As Integer
 
 gbAbbruch = False
 iOffset = -1
 
 With Sheets("Tabelle1")
  For j = 1 To Val(.Range("F3").Value)
      m = .Shapes("Bild").Top
      If m < 1 Or m > 200 Then m = 200
      
      For i = 1 To 380
        Sleep 10
        .Shapes("Bild").Top = m
        m = m + iOffset
        If m < 10 Then iOffset = 1
        If m > 200 Then iOffset = -1
        DoEvents
        If gbAbbruch Then Exit Sub
    Next i
   Next j
 End With
End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz

[Andrek]

Karl-Heinz, 

vielen herzlichen Dank  :28:

Mich fasziniert immer wie schnell ihr das Problem lösen könnt!  :28: :23:

LG Andre

[Andrek]

Hallo zusammen,

wieder sind die Experten gefragt. Bin wieder auf Problem gestoßen:

- ich möchte mehrere Animation gleichzeitig/parallel ausführen lassen! 

Um genau mein Problem zu verstehen => folgendes Beispiel:

Ich starte Animation Nr1(Animation läuft) => jetzt möchte ich Animation Nr2 starten während die Animation Nr.1 immer noch am laufen ist. Es sollen dann beide Animationen laufen bis ich eine davon, dann selber stoppe oder deren Code läuft ab.

Mein Ziel ist mehrere Animation parallel laufen zulassen, aber zwischen durch eine oder die andere per STOP-Button dann anhalten oder wieder starten ohne das die andere gestört werden.

In Moment ist das so, wenn die Animation Nr1 läuft und ich starte die Animation Nr.2, dann wird die Animation Nr1 angehalten. Stoppe ich die Animation Nr.2, dann läuft die Nr.1 weiter(siehe Anhang) 

Habe schon probiert verschiedene Sachen/Variable umzubenennen usw. aber kein Erfolg.

Deswegen möchte ich euch um Hilfe bitten! Ist es überhaupt möglich 2 oder mehrere Animation unabhängig von einander laufen zulassen?

LG Andre 

P.S: falls mein geänderte Code komisch aussieht bitte nicht mit den Steinen bewerfen - habe halt selber versucht verschiedene Möglichkeiten durchzuspielen 

[volti]

Hall Andre,

ich hatte es schon so kommen sehen.  :19:

Aber nun zum Thema. Es können nicht mehrere Sub's parallel  ablaufen. Um mehrere Animationen "gleichzeitig" laufen zu lassen, müsste man entweder mit TimerProcs arbeiten oder man packt alle Abläufe in eine Sub.

Ich kann mich gerne damit im Laufe des Tages beschäftigen und Dir einen Vorschlag machen...

viele Grüße
Karl-Heinz

[Elex]

Hi

Hatte etwas Zeit übrig.

  Animation.xlsm (Größe: 21,87 KB / Downloads: 5)

Gruß Elex

[schauan]

Hallöchen,

das wäre mal meine Variante, hier mit 1s Schaltzeit. Du musst alle 4 Buttons neu zuweisen und mal den Namen vom blauen Bild prüfen und ggf. auf Bild1 ändern.

Edit: Makro Animation korrigiert.

Code:

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

Public gbAbbruch(1), posm(1)

Sub Stoppen0()
    gbAbbruch(0) = True
End Sub
Sub Stoppen1()
    gbAbbruch(1) = True
End Sub
Sub Starten0()
    gbAbbruch(0) = False
    Animation 0
End Sub
Sub Starten1()
    gbAbbruch(1) = False
    Animation 1
End Sub

Sub Animation(ByVal iNr As Integer, Optional iOffset2 As Integer = 1)
With Sheets("Tabelle1")
      posm(iNr) = .Shapes("Bild" & iNr + 1).Top
      If posm(iNr) < 50 Then posm(iNr) = 50
      If posm(iNr) > 100 Then posm(iNr) = 100
      If posm(iNr) = 50 Then iOffset2 = 1
      If posm(iNr) = 100 Then iOffset2 = -1
      posm(iNr) = posm(iNr) + iOffset2
      .Shapes("Bild" & iNr + 1).Top = posm(iNr)
      DoEvents
      If gbAbbruch(iNr) Then Exit Sub
      Application.OnTime Time + TimeSerial(0, 0, 1), ThisWorkbook.FullName & "!'Animation " & iNr & "," & iOffset2 & " '"
End With
End Sub

[volti]

Hallo,

es gibt zwar schon zwei schöne Varianten, trotzdem will ich meine Version Euch nicht vorenthalten.
Bin bei Ein/Aus-Schalten geblieben, kann aber auch als Toggle umgebaut werden...

Diese Version ist ohne weiteren Code bis auf 9 Animationen erweiterbar.

Es gibt auch nur eine Anlauf-Sub nach Klicken eines Buttons. Hierfür muss aber die Benennung der Button fortlaufend sein.
Kann mit der "Button_Umbenennen"-Sub bei Bedarf sichergestellt werden.

Wenn alle Animationen ausgeschaltet sind, wird die Hauptschleife verlassen...


  Animation_Andre.xlsm (Größe: 33,06 KB / Downloads: 4)

viele Grüße
Karl-Heinz

[Andrek]

Leute, vielen, vielen Dank euch!  :23:

3 verschiede Versionen, aber jede funktioniert auf ihre eigene Art und Weise  :28:

Diese Version ist ohne weiteren Code bis auf 9 Animationen erweiterbar.

Karl-Heinz, vielen Dank! Das ist genau das was ich brauche! Habe schon eine 3-te Animation dazugefügt und es hat funktioniert!  :35:  

Muss jetzt alle 3 Varianten genauer betrachten und versuchen zu verstehen was da in jeden einzelnen Fall(bei jede Version) abläuft 

Ich bin euch wirklich sehr Dankbar! :100:

LG Andre