Antwort
zweiter Teil:
Sub CreateClockShape()
On Error GoTo AbortClockShape
'first check if shape already exists
Dim sh As Shape
On Error Resume Next
Set sh = ActiveSlide.Shapes("PointaixClockLabel")
On Error GoTo AbortClockShape
If sh Is Nothing Then
'shape with that name does not exist, so lets create it
With ActiveSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=300, Top:=8, Width:=75, Height:=14)
'Set name
.Name = "PointaixClockLabel"
' fill parameters
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0#
' line parameters
.Line.Weight = 2#
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
'Text & font size
With .TextFrame.TextRange
.Text = Format(Now(), TIMEFORMATSTRING)
.Font.Size = 12
.Font.Italic = False
.Font.Color.RGB = RGB(255, 255, 255)
End With
End With
Set sh = ActiveSlide.Shapes("PointaixClockLabel")
Else
'we found the shape - lets simply update the text
sh.TextFrame.TextRange.Text = Format(Now(), TIMEFORMATSTRING)
End If
Exit Sub
AbortClockShape:
MsgBox Err.Description
End Sub
Sub DeletePrevClockShape()
On Error GoTo ErrorOccurred
'If Not prevSlideIdx Is Nothing Then
If prevSlideIdx > 0 Then
ActivePresentation.Slides(prevSlideIdx).Shapes("PointaixClockLabel").Delete
End If
Exit Sub
ErrorOccurred:
MsgBox Err.Description
End Sub
'returns a reference of the active slide
Function ActiveSlide() As Slide
On Error GoTo ErrHandler
Set ActiveSlide = ActivePresentation.SlideShowWindow.View.Slide
Exit Function
ErrHandler:
Set ActiveSlide = Nothing
End Function