Sub BewText()
Dim Shps As Shapes
Dim WArtTxt As Shape
Dim inc As Integer
On Local Error GoTo BewText_Err
Set Shps = ActiveSheet.Shapes
' add neuen text
' methode AddTextEffect blder einen WordArtText und
' returnes einen shape object :
Set WArtTxt = Shps.AddTextEffect(PresetTextEffect:=msoTextEffect22, _
text:="Hallo Miriam :-)", _
FontName:="Arial", _
FontSize:=15, _
FontBold:=msoFalse, _
FontItalic:=msoFalse, _
Left:=Cells(1, 1).Left, _
Top:=Cells(1, 1).Top)
For inc = 1 To 600
WArtTxt.Left = inc
WArtTxt.Top = inc
WArtTxt.Rotation = inc
If (inc Mod 5 = 0) Then
If (WArtTxt.Visible = msoFalse) Then
WArtTxt.Visible = msoTrue
Else
WArtTxt.Visible = msoFalse
End If
End If
DoEvents
Next inc
' text wieder loeschen
WArtTxt.Delete
Exit Sub
BewText_Err:
MsgBox "Error " & Err.Number, vbCritical, "Error"
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen