OT vba bei powerpoint, fehler in der vba schleife?

04/04/2009 - 21:43 von jaquesthereal | Report spam
hallo liebe excel vba gemeinde,
ich hab ein vba / powerpoint problem, allerdings ist das eher vba als
powerpoint, daher wage ich es auch hier zu stellen :) (weil die
powerpoint vba gemeinde mir nicht antwortet :( )
ich hoffe das ist genehm.


die grunddaten hab ich von hier:
http://www.vb-fun.de/cgi-bin/forumarchiv.pl?archiv69&ID=1&action=zeigeseite&nummer•265#Atext

allerdings angepasst + fehler drin :D

also ich erstelle einer powerpoint pràsi mit vielen folien
auf jeder folie möchte ich kàstchen darstellen für die anzahl der
folien + ein anders farbiges kàstchen für den aktuellen verlauf
innerhalb der pràsi
das funkioniert auch, allerdings beim mehrmaligen ausführen der sub
werden nicht immer alle kàstchen entfernt, was dazu führt das ich auf
einigen folien sehr viele kàstchen darstelle, zwar alle übereinander
sodass es nicht so schlimm ist, aber das macht die pràsi auf meinem
rechner elendig langsam
und ich will es einfach nicht :D, vonwegen sauber programmieren und so

dazu hab ich auch diverse lösungsansàtze versucht um meine kàstchen zu
entfernen, allerdings funktioniert das nicht und genau das ist meine
frage, wo ist der fehler?!

ich habe mal die gesamte sub gepostet, darf gerne verwendet werden
wenn mir der fehler erklàrt wird :D
danke schön
gruss jochen

ps ich hab auch mal den support für das bild drin gelassen! ;)

Sub CountPlaceCounter()
Dim i As Long
Dim objPres As Presentation
Dim Count As Long
Dim nSlide As Long
Dim nSlidePicture As Long
Dim objShape As Shape

Dim oSlide As Slide
Dim oPicture As Shape
Dim sImagePath As String

' Initialize the counter.
Count = 0

Set objPres = ActivePresentation
If objPres.Slides.Count > 0 Then
Count = objPres.Slides.Count

'hier versuche ich die shapes zu entfernen!
' mit diverersen ideen, die hab ich extra drin gelassen, es hat
nàmlich keine funktionert :(
' verusch einfach zu zàhlen, Do While, While, ... einfach ratlos :)
For nSlide = 1 To Count
i = 1
' Do While InStr(1, objPres.Slides(nSlide).Shapes
(i).Name, "seitenanzeiger") > 0
If objPres.Slides(nSlide).Shapes.Count > i And InStr(1,
objPres.Slides(nSlide).Shapes(i).Name, "seitenanzeiger") > 0 Then
Do While InStr(1, objPres.Slides(nSlide).Shapes
(i).Name, "seitenanzeiger") > 0
Debug.Print nSlide & ": " & objPres.Slides(nSlide).Shapes(i).Name
objPres.Slides(nSlide).Shapes(i).Delete
i = i + 1
Loop
End If
' For i = 1 To objPres.Slides(nSlide).Shapes.Count
' Set objShape = objPres.Slides(nSlide).Shapes(i)
'Debug.Print nSlide & ": " & objShape.Name
' If InStr(1, objShape.Name, "seitenanzeiger") > 0 Then
' objShape.Delete
' End If
' Next i


For Each objShape In objPres.Slides(nSlide).Shapes
'Debug.Print nSlide & ": " & objShape.Name
If InStr(1, objShape.Name, "seitenanzeiger") > 0 Then
objShape.Delete
End If
Next
Next nSlide


For nSlide = 1 To Count
Set oSlide = ActiveWindow.Presentation.Slides(nSlide)
For nSlidePicture = 1 To Count
If nSlidePicture = nSlide Then
sImagePath = "c:\blau.png"
Set oPicture = oSlide.Shapes.AddShape
(msoShapeRectangle, 50 + nSlidePicture * 19, 400, 10, 10)
' Set oPicture = oSlide.Shapes.AddPicture
(sImagePath, _
msoFalse, msoTrue, 1, 2, 3, 4)
oPicture.Fill.ForeColor.RGB = RGB(0, 0, 200) 'blau
Else
sImagePath = "c:ot.png"
Set oPicture = oSlide.Shapes.AddShape
(msoShapeRectangle, 50 + nSlidePicture * 19, 400, 10, 10)
' Set oPicture = oSlide.Shapes.AddPicture
(sImagePath, _
msoFalse, msoTrue, 1, 2, 3, 4)
oPicture.Fill.ForeColor.RGB = RGB(200, 0, 0) 'rot
End If
oPicture.Name = "seitenanzeiger"

' oPicture.ScaleHeight 1, msoTrue
' oPicture.ScaleWidth 1, msoTrue
With ActivePresentation.PageSetup
' oPicture.Left = 50 + nSlidePicture * 17
' oPicture.Top = 400
End With
Next nSlidePicture
Next nSlide
End If
End Sub
 

Lesen sie die antworten

#1 Andreas Killer
05/04/2009 - 12:14 | Warnen spam
schrieb:

ich hab ein vba / powerpoint problem, allerdings ist das eher vba als
powerpoint, daher wage ich es auch hier zu stellen :) (weil die
powerpoint vba gemeinde mir nicht antwortet :( )
ich hoffe das ist genehm.


Tja, wer weiß... :-))

also ich erstelle einer powerpoint pràsi mit vielen folien
auf jeder folie möchte ich kàstchen darstellen für die anzahl der
folien + ein anders farbiges kàstchen für den aktuellen verlauf
innerhalb der pràsi
das funkioniert auch, allerdings beim mehrmaligen ausführen der sub
werden nicht immer alle kàstchen entfernt, was dazu führt das ich auf
einigen folien sehr viele kàstchen darstelle, zwar alle übereinander
sodass es nicht so schlimm ist, aber das macht die pràsi auf meinem
rechner elendig langsam


2 Probleme:

a.) Wenn Du ein Shape löscht, dann verringert sich die Anzahl von
Shapes.Count. Deswegen geht keine FOR-Schleife

b.) Bei der Benennung der Shapes dürfen diese nicht alle den gleichen
Namen haben.

Ich hab das mal ausgemistet und etwas gestrafft.

Andreas.

Option Explicit
Option Compare Text

Sub CountPlaceCounter()
Dim nSlide As Long, i As Long
Dim objPres As Presentation
Dim objShape As Shape
Dim oSlide As Slide

Set objPres = ActivePresentation

'Alle Seiten durchlaufen
For nSlide = 1 To objPres.Slides.Count
With objPres.Slides(nSlide)
i = 1
'alle Shapes durchlaufen
Do While i <= .Shapes.Count
Set objShape = .Shapes(i)
'Ist es ein Seitenanzeiger?
If InStr(objShape.Name, "seitenanzeiger") = 1 Then
'Löschen
objShape.Delete
Else
'Nàchstes Shape
i = i + 1
End If
Loop
End With
Next

'Seitenanzeiger hinzufügen
For nSlide = 1 To objPres.Slides.Count
Set oSlide = objPres.Slides(nSlide)
For i = 1 To nSlide
Set objShape = oSlide.Shapes.AddShape(msoShapeRectangle, 50 _
+ i * 19, 400, 10, 10)
If i = nSlide Then
objShape.Fill.ForeColor.RGB = RGB(0, 0, 200) 'blau
Else
objShape.Fill.ForeColor.RGB = RGB(200, 0, 0) 'rot
End If
objShape.Name = "seitenanzeiger" & nSlide & "-" & i
Next
Next
End Sub

Ähnliche fragen