Sub Hinweis_erstellen()
Dim AZZ As Long
Dim AZS As Integer
'Position der Einfügemarke zwischenspeichern
AZZ = ActiveCell.Row
AZS = ActiveCell.Column
ActiveSheet.Unprotect 'Schutz aufheben
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 45, 98, 216, 21).Select
Selection.Name = "Text Box 1"
Selection.Characters.Text = "Hinweis: Ich verschwinde gleich !"
With Selection.Characters(Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 12
.Underline = xlUnderlineStyleSingle
End With
With Selection.Characters(Start:=9, Length:=39).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.ColorIndex = 10 '11
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
ActiveSheet.Protect 'Schutz wieder setzen
'Position der Einfügemarke wieder herstellen
Cells(AZZ, AZS).Select
'nach Zeitablauf von 2 Sekunden das Makro
'zum Löschen des Textfeldes aufrufen
Application.OnTime Now + TimeValue("00:00:05"), ThisWorkbook.Name & "!Hinweis_löschen"
End Sub
'
'das zuvor erstellte Textfeld löschen
'
Sub Hinweis_löschen()
ActiveSheet.Unprotect 'Schutz aufheben
'das Textfeld löschen
ActiveSheet.Shapes("Text Box 1").Delete
ActiveSheet.Protect 'Schutz wieder setzen
End Sub