Animation VBA-Optimierung

[volti]

Hallo Andre,

danke für die Rückmeldung.

Im Prinzip kannst Du für jede Animation Start und Endpunkt sowie die Gesamtlaufdauer individuell festlegen.
Auch die Geschwindigkeit einer Animation kann über iSchritt erhöht werden.
Falls Du irgendwann auch horizontal bewegen willst, ist die X-Position schon berücksichtigt. Allerdings noch kein Code dafür.

Aber, Excel ist kein Animationsprogramm, da kann es schon mal ruckeln und bei noch mehr Aniamtionen langsamer werden...

Hier noch mal eine kleine Anpassung/Ergänzung...

Code:

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

Const Ani_Anz As Integer = 2

Type POINTAPI
      x    As Long
      y    As Long
End Type

Type Ani_STRUCT
  bEinAus  As Boolean
  sShape   As String
  iOffset  As Integer
  iSchritt As Integer
  Pos      As POINTAPI
  iMin     As Integer
  iMax     As Integer
  iLoop    As Integer
  iLoopMax As Integer
End Type

Dim Ani(9) As Ani_STRUCT
Dim i      As Integer
Dim gbRun  As Boolean

Sub Ani_Init()
'Anfangszustände und Shapenamen setzen
 Dim WSh As Worksheet
 
 Set WSh = ThisWorkbook.Sheets("Tabelle1")
  
 Ani(1).iLoopMax = Val(WSh.Range("B9").Value)
 Ani(2).iLoopMax = Val(WSh.Range("I9").Value)
 Ani(0).bEinAus = True
 
 For i = 1 To Ani_Anz
   With Ani(i)
     .bEinAus = False
     .sShape = "Bild" & i
     .iOffset = -1
     .iSchritt = 1
     .iMin = 10
     .iMax = 200
     .Pos.x = WSh.Shapes(.sShape).Left
     .Pos.y = WSh.Shapes(.sShape).Top
     If .Pos.y < .iMin Then .Pos.y = .iMin
     If .Pos.y > .iMax Then .Pos.y = .iMax
     .iLoop = 1
     .iLoopMax = .iLoopMax * .iMax
     If .iLoopMax < .iMax Then .iLoopMax = .iMax
   End With
 Next i
 Ani(2).iSchritt = 3    'Beispiel Animation 3x so schnell

End Sub



Sub AnimationProc()
 Dim WSh As Worksheet, bCheck As Boolean
 
 Set WSh = ThisWorkbook.Sheets("Tabelle1")
 gbRun = True
 
 Do
   bCheck = True
   For i = 1 To Ani_Anz                                         'Alle Animationn durchgehen
       With Ani(i)
          If .bEinAus Then bCheck = False
          If .bEinAus And .iLoop < .iLoopMax Then               'wenn nicht gestoppt
             WSh.Shapes(.sShape).Top = .Pos.y                   'Position setzen
             .Pos.y = .Pos.y + .iOffset                         'Neue Position
             If .Pos.y < .iMin Then .iOffset = 1 * .iSchritt    'Richtung umkehren
             If .Pos.y > .iMax Then .iOffset = (-1) * .iSchritt 'Richtung umkehren
             .iLoop = .iLoop + 1                                'Durchgangszähler
          End If
       End With
       DoEvents
   Next i
   Sleep 5                                                      'Zeitverzögerung
   If Ani(0).bEinAus = False Or bCheck Then Exit Do             'Animation verlassen
 Loop
 gbRun = False
 
End Sub

Sub StartenStoppen()
'Schaltet die Animation frei oder stoppt sie
'Unterscheidung anhand des Button-Namens
 Dim j As Integer
 
 j = Val(Right(Application.Caller, 1))
 Select Case Val(Right(Application.Caller, 2))
 Case Is >= 20
   Ani(j).bEinAus = False
 Case Else
   If gbRun = False Then Call Ani_Init
   Ani(j).bEinAus = True
   If gbRun = False Then Call AnimationProc
 End Select
End Sub

Sub StoppAll()
'Stoppt alle Animationen
  Ani(0).bEinAus = False
End Sub

Sub Button_Umbenennen()
'Button markieren, den u.a. Namen vergeben und Makro starten
'Startbuttons = Button 11, Button 12, Button 13 usw.
'Stoppbuttons = Button 21, Button 22, Button 23 usw.
 Debug.Print Selection.Name
 Selection.Name = "Button 22"
End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz

[Andrek]

Vielen Dank, Karl-Heinz  :100:

Ich habe eine Aufgabe bekommen paar Ausbildungsdateien in EXCEL zu stellen - um dem Prozess besser zu verstehen. Das System besitzt mehrere Filter die unabhängig vor einander Ein-/Ausgeschaltet werden können. Und durch kleine Animation(Bewegung im Filter) wollte ich besser darstellen welche Filter in Moment in Betrieb ist und welcher nicht. Somit hat man besseren optischen Übersicht. 

Falls Du irgendwann auch horizontal bewegen willst, ist die X-Position schon berücksichtigt. Allerdings noch kein Code dafür.

Verstehe ich da richtig: kann dann in Prinzip im Code einfach alle Y-Abfragen durch X austauschen und die Bewegung wird horizontal ausgeführt? 


Wie gesagt, ich werde bei der Gelegenheit gemütlich gesamte Code anschauen und versuche einige Sachen zu verändert - somit werde ich sehen was passiert(Lernen durch tuen)   :19:

LG Andre

---

Ani(2).iSchritt = 3    'Beispiel Animation 3x so schnell

Vielen dank für die gesamte Beschriftung, das tut mir wirklich helfen den Code besser zu verstehen!  :100:

LG Andre

[schauan]

Hallöchen,

mal noch ein paar Anmerkungen.

Bei der Parameterhinterlegung mit den beiden Arrays kannst Du hunderte Animationen starten (falls Excel das hier mitmacht) Du musst nur die Dimensionierung des Arrays entsprechend hoch setzen.

Wenn man bei den Formular-Buttons die Bildnummer und die Aktion Start - Stop z.B. im Objektnamen "verschlüsselt" hinterlegt braucht man nur jeweils ein Makro zum Start und eins zum Beenden. Dann wird meine Version noch kürzer

Ich habe die Buttons zum Start mal Schalter01 und Schalter11 genannt und zum Stop Schalter00 und Schalter10. Wäre also jeweils eine zweistellige Zahl und damit auf 10 Objekte begrenzt. Will man mehr, nimmt man dreistellige Zahlen
Damit würde zum Starten und Stoppen das eine Makro hier reichen und die Codeänderung würde nur noch die Arraydimensionierung betreffen. Man muss aber eben sehr auf die Schalternamen und die Bildnamen achten und das könnte beim Austausch etwas tricky werden ...

Code:

Sub StartStop()
gbAbbruch((Left(Right(Application.Caller, 2), 1))) = (Right(Application.Caller, 1) = "0")
Animation Left(Right(Application.Caller, 2), 1)
End Sub

Das sleep kann auch weg, das ist noch vom ursprünglichen Code

Mit Klassenprogrammierung sollte es übrigens auch gehen

[Andrek]

Andre, vielen Dank für deine Mühe. 

Die Vorgehensweise ist mir neu, aber ich werde mich auf jeden Fall damit beschäftigen um auch diese Möglichkeit zu verstehen!  

LG Andre   :15:

[schauan]

Hallöchen,

hier mal noch die Datei

[volti]

Hallo Andre,

hier abschließend noch eine Version, die auch waagegerecht bzw. diagonal kann.
Natürlich kann man auch mehr als 9 Anis machen, dazu brauchen nur die Buttonnamen erweitert werden und ggf. etwas Code angepasst.
Aber das macht Excel wohl kaum mit.

Für iOffset kannst Du jetzt auch Werte >1 einsetzen...

Da hast Du ja jetzt Auswahl genug mit den drei Versionen, viel Erfolg.


  Animation_Andre.xlsm (Größe: 32,9 KB / Downloads: 3)

VG KH

[Andrek]

Andre, Karl-Heinz, vielen, vielen Dank euch! 


So ein Einsatz ist traumhaft! Bin wirklich Sprachlos!  :23:  :15:

Natürlich kann man auch mehr als 9 Anis machen, dazu brauchen nur die Buttonnamen erweitert werden und ggf. etwas Code angepasst.

Aber das macht Excel wohl kaum mit.

@ Karl-Heinz
das reicht mir voll und ganz - mehr als 9 wird es auf keinen Fall! 

LG Andre

[volti]

Hallo Andre,

hier gemäß Deiner Anfrage auch eine Version, die mit Active-X-Buttons arbeitet.
Habe ich mal in Tabelle 2 vergleichsweise dazugebaut.

Damit nicht für jeden Button eine Sub angelegt werden muss, habe ich das über Klassenprogrammierung realisiert...

Tete mal.


  Animation_Andre.xlsm (Größe: 55,14 KB / Downloads: 2)

viele Grüße
Karl-Heinz

[Andrek]

Vielen herzlichen Dank, Karl-Heinz!  :100:

LG
Andre