Thema: Animierte TextBox über das Arbeitsblatt bewegen

StandardModule: Modul1

Sub Bewegen()
   Dim iLeft As Integer, iTop As Integer
   ActiveSheet.Unprotect
   With ActiveSheet.TextBoxes(1)
      For iLeft = 1 To 400
         Call SetColors(iLeft)
         .Left = iLeft
      Next iLeft
      For iTop = 1 To 260
         Call SetColors(iTop)
         .Top = iTop
      Next iTop
      For iLeft = 400 To 1 Step -1
         Call SetColors(iLeft)
         .Left = iLeft
      Next iLeft
      For iTop = 260 To 1 Step -1
         Call SetColors(iTop)
         .Top = iTop
      Next iTop
      .Interior.ColorIndex = 0
   End With
   ActiveSheet.Protect
End Sub

Private Sub SetColors(iCount As Integer)
   With ActiveSheet.TextBoxes(1)
      If iCount Mod 20 = 0 Then
        If .Interior.ColorIndex = 3 Then
           .Interior.ColorIndex = 6
        Else
           .Interior.ColorIndex = 3
        End If
      End If
      If iCount Mod 100 = 0 Then
         If .Text = "DANGER" Then .Text = "" Else .Text = "DANGER"
      End If
   End With
End Sub

Beiträge aus dem Excel-Forum zu den Themen Grafik und Animation