Gruppe
Grafik
Problem
Eine animierte TextBox soll über das aktive Blatt bewegt werden.
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