- #1
G
Guest
Guest
Folgender Code verursacht bei mir einen Out of Range Error, leider weiß ich nicht warum.
-------------------------------------------------------------------------------------------
Sub Anything()
Dim sl As Slide
Dim ii As Integer
Dim i As Integer
For Each sl In ActivePresentation.Slides
If sl.Shapes.HasTitle = msoTrue Then
If sl.Shapes.Title.TextFrame.HasText = msoFalse Then
sl.Shapes.Title.Delete
End If
End If
ii = sl.Shapes.Count
i = 1
MsgBox ii
Do
With sl.Shapes(i)
If .HasTextFrame = msoTrue Then
With .AnimationSettings
.Animate = msoTrue
.EntryEffect = ppEffectFlyFromLeft
.TextLevelEffect = ppAnimateByFirstLevel
.AnimateBackground = msoTrue
End With
End If
End With
i = i + 1
Loop Until i < ii
Next
End Sub
---------------------------------------------------------------------------------------------
Wäre nett wenn ich mir sagen könntet wo der Fehler liegt.
-------------------------------------------------------------------------------------------
Sub Anything()
Dim sl As Slide
Dim ii As Integer
Dim i As Integer
For Each sl In ActivePresentation.Slides
If sl.Shapes.HasTitle = msoTrue Then
If sl.Shapes.Title.TextFrame.HasText = msoFalse Then
sl.Shapes.Title.Delete
End If
End If
ii = sl.Shapes.Count
i = 1
MsgBox ii
Do
With sl.Shapes(i)
If .HasTextFrame = msoTrue Then
With .AnimationSettings
.Animate = msoTrue
.EntryEffect = ppEffectFlyFromLeft
.TextLevelEffect = ppAnimateByFirstLevel
.AnimateBackground = msoTrue
End With
End If
End With
i = i + 1
Loop Until i < ii
Next
End Sub
---------------------------------------------------------------------------------------------
Wäre nett wenn ich mir sagen könntet wo der Fehler liegt.