PowerPoint und VBA

Computer: Software & Programmierung Visual Basic
#1

Hallo,

hab ein kleines Problem,

ich wollte in Ppt ein Makro schreiben, in der er mir eine „Bilderserie“ erstellt, die nacheinander abläuft. Dabei soll - ähnlich wie auf einem Film - jede Veränderung auf einer neuen Folie zu finden sein. Nun wollte ich per Makro das so gestalten, dass er mir am Anfang eine neue Folie einfügt (kein Problem) und dann einen vorhanden Kreis um einen bestimmten Wert nach rechts und unten (oder auch oben und links) verschiebt.
Nun hab ich irgendwie das Problem, dass er mir die Maße irgendwie durcheinander haut. Wenn ich das Programm ohne For…Next-Schleife durchlaufen lasse und sage tu auf der neuen Seite den Kreis ganz an den unteren Rand (bei 478 als Maß) dann macht er das ohne Problem. Sag ich jedoch das ganze über eine Schleife um eben mehrere Seiten und das ganze in kleineren Schritten durchzuführen, ist der Kreis dann irgendwo unter dem Folienrand zu finden. Erst recht zur Verwirrung führt, dass die Maße um so mehr abweichen, sobald ich Kommaschritte als Step definiere.
Wer kann mich aufklären in dieser Beziehung?

Danke im Voraus
Tobi@s

#2

Ich weiss nicht genau, warum das bei Dir passiert, aber bei mir geht´s.
Hier mal zwei Varianten:

Option Explicit

'Artikel: http://www.wer-weiss-was.de/cgi-bin/forum/showarchive.fpl?special=id&ArtikelID=3077570
'Datum: 23.08.2005
'Kristian Zarse


Const sng\_Pt2Cm As Single = 28.3375


'#########################################################################


Sub LeereFolienAnhaengen()
Dim i As Integer
Dim f1 As Integer
Dim max As Integer

 max = 50
 f1 = ActivePresentation.Slides.Count + 1
 For i = f1 To max
 ActivePresentation.Slides.Add f1, ppLayoutBlank
 Next i
End Sub 'LeereFolienAnhaengen


'#########################################################################


Sub KreisWanderung\_Copy()
Const sng\_FaktorTop As Single = 9 'pt
Const sng\_FaktorLeft As Single = 12 'pt

Dim sngBasisTop As Single
Dim sngBasisLeft As Single

Dim i As Integer
Dim SR As ShapeRange

 With ActivePresentation.Slides(1).Shapes(1)
 .Copy
 sngBasisTop = .Top
 sngBasisLeft = .Left
 End With 'ActivePresentation.Slides(1).Shapes(1)

 For i = 2 To ActivePresentation.Slides.Count
 With ActivePresentation.Slides(i)
 .Select 'damit mal den kopierten Kreis einfügen kann
 Set SR = .Shapes.Paste 'den vorher auf Folie 1 kopierten Kreis einfügen
 SR.Top = sngBasisTop + (i - 1) \* sng\_FaktorTop
 SR.Left = sngBasisLeft + (i - 1) \* sng\_FaktorLeft
 End With 'ActivePresentation.Slides(i)
 Next i
 Set SR = Nothing
End Sub 'KreisWanderung\_Copy


'#########################################################################


Sub KreisWanderung\_Add()
Const sng\_FaktorTop As Single = 9 '9 Punkte
Const sng\_FaktorLeft As Single = 12 '12 Punkte
Const sng\_BasisTop As Single = 0.7 \* sng\_Pt2Cm '0,7cm
Const sng\_BasisLeft As Single = 0.7 \* sng\_Pt2Cm '0,7cm

Dim i As Integer
Dim S As Shape

Dim L As Single
Dim T As Single
Const W As Single = 2 \* sng\_Pt2Cm '2cm
Const H As Single = 2 \* sng\_Pt2Cm '2cm

 For i = 1 To ActivePresentation.Slides.Count
 With ActivePresentation.Slides(i)
 .Select 'damit mal den kopierten Kreis einfügen kann
 L = sng\_BasisLeft + (i - 1) \* sng\_FaktorLeft
 T = sng\_BasisTop + (i - 1) \* sng\_FaktorTop
 Set S = .Shapes.AddShape(msoShapeOval, L, T, W, H)
 S.Fill.ForeColor.RGB = RGB(255, 255, 0) 'gelb, z.B.
 End With 'ActivePresentation.Slides(i)
 Next i
 Set S = Nothing
End Sub 'KreisWanderung\_Add

Mit der ersten Funktion legt man erstmal entsprechend viele Folien an, wenn sie nicht schon da sind (in diesem Falle wird auf 50 Stück aufgefüllt), oder es werden 50 neue angelegt, wenn es noch gar keine gibt).

Dann kommt die eigentliche Funktion:

Bei der ersten Variante erstellt man manuell ein Shape-Objekt (z.B. Kreis), das dann entsprechend auf die anderen Folien kopiert wird (Vorteil: alle Formate werden mitkopiert). Zu beachten ist, dass das Makro davon ausgeht, dass das zu kopierende Objekt das mit dem Index 1 ist. Da gibt´s auch andere Möglichkeiten, wenn das nicht passt.

Bei der zweiten Variante wird jedes Objekt neu angelegt, also auch das etste (Nachteil: Es wird immer das aktuelle Standard-Format vewendet, und man muss ggf. manuell nachformatieren).

Probier´s mal aus. Leg´ Dir eine leere Präsentation an, kopiere den Code dort rein, lege die Folien an mit der erste Funktion und spiele dann mit den anderen beiden rum.

Ist das das, was Du meinst?

Kristian

PS: Hier nochmal derselbe Code, aber ohne Einrückung, da es mit dem Copy/Paste der obigen Variante immer Probleme gibt:

Option Explicit
 
'Artikel: http://www.wer-weiss-was.de/cgi-bin/forum/showarchiv…
'Datum: 23.08.2005
'Kristian Zarse
 
 
Const sng_Pt2Cm As Single = 28.3375
 
 
'#########################################################################
 
 
Sub LeereFolienAnhaengen()
Dim i As Integer
Dim f1 As Integer
Dim max As Integer
    
    max = 50
    f1 = ActivePresentation.Slides.Count + 1
    For i = f1 To max
        ActivePresentation.Slides.Add f1, ppLayoutBlank
    Next i
End Sub 'LeereFolienAnhaengen
 
 
'#########################################################################
 
 
Sub KreisWanderung_Copy()
Const sng_FaktorTop As Single = 9 'pt
Const sng_FaktorLeft As Single = 12 'pt
 
Dim sngBasisTop As Single
Dim sngBasisLeft As Single
 
Dim i As Integer
Dim SR As ShapeRange
 
    With ActivePresentation.Slides(1).Shapes(1)
        .Copy
        sngBasisTop = .Top
        sngBasisLeft = .Left
    End With 'ActivePresentation.Slides(1).Shapes(1)
    
    For i = 2 To ActivePresentation.Slides.Count
        With ActivePresentation.Slides(i)
            .Select 'damit mal den kopierten Kreis einfügen kann
            Set SR = .Shapes.Paste  'den vorher auf Folie 1 kopierten Kreis einfügen
            SR.Top = sngBasisTop + (i - 1) * sng_FaktorTop
            SR.Left = sngBasisLeft + (i - 1) * sng_FaktorLeft
        End With 'ActivePresentation.Slides(i)
    Next i
    Set SR = Nothing
End Sub 'KreisWanderung_Copy
 
 
'#########################################################################
 
 
Sub KreisWanderung_Add()
Const sng_FaktorTop As Single = 9 '9 Punkte
Const sng_FaktorLeft As Single = 12 '12 Punkte
Const sng_BasisTop As Single = 0.7 * sng_Pt2Cm '0,7cm
Const sng_BasisLeft As Single = 0.7 * sng_Pt2Cm '0,7cm
 
Dim i As Integer
Dim S As Shape
 
Dim L As Single
Dim T As Single
Const W As Single = 2 * sng_Pt2Cm '2cm
Const H As Single = 2 * sng_Pt2Cm '2cm
 
    For i = 1 To ActivePresentation.Slides.Count
        With ActivePresentation.Slides(i)
            .Select 'damit mal den kopierten Kreis einfügen kann
            L = sng_BasisLeft + (i - 1) * sng_FaktorLeft
            T = sng_BasisTop + (i - 1) * sng_FaktorTop
            Set S = .Shapes.AddShape(msoShapeOval, L, T, W, H)
            S.Fill.ForeColor.RGB = RGB(255, 255, 0)  'gelb, z.B.
        End With 'ActivePresentation.Slides(i)
    Next i
    Set S = Nothing
End Sub 'KreisWanderung_Add

#3

Hallo Kristian,

ich werde zwar erst in den nächsten Tagen dazu kommen, den Code zu integrieren aber erst einmal Danke dafür.

Tobi@s