Gruppe
Grafik
Bereich
Animation
Thema
Animierte TextBox über das Arbeitsblatt bewegen
Problem
Eine animierte TextBox soll über das aktive Blatt bewegt werden.
Lösung
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.
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