Clever-Excel-Forum

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