Powerpoint 2007 Makro Fehlerhaft

16/01/2009 - 14:02 von Wazlav Gizycki | Report spam
Hallo Group,

bràuchte mal euren Rat. Ich habe ein Makro geschrieben, mit dem ich
eine PPT Pràsi erstelle, um Bilder aus einem Ordner auch Folien
einzufügen, z.B Urlaubsbilder, die kann man dann beschriften und an
Freunde und verwandte schicken. Dazu benutze ich IrfanView um die
Bilder auf eine Größe zu bringen und kopiere die Bilder anschließend
auf die Folien.
Dabei geht aber was schief. Ich dDrehe die Hochkant Bilder um 90°
damit z.B. vier Fotos auf eine Folie passen. Aber wenn ich die Bilder
gedreht habe, haben Sie eine andere Position auf der Folie als die,
die schon normal waren, obwohl ich immer die gleichen Koordinaten
verwende. Irgendiwe komme ich nicht weiter. Im Code könnt ihr sehen,
dass ich verschiedene Varianten ausprobiert habe.
Aber keine der Varianten Funktioniert richtig...

Wàre Cool wenn ihr mal drüber schauen würdet. Ich habe bisher nur VBA
in verbindung mit Access verwendet.

Vielen Dank

Sub Bilder_kopieren()

'Variablendeffinition

Dim fs, f, f1, fc, g, g1, gc, Bilder_Anzahl
Dim User, Datum, CD_Folder, Verzeichnis, IrfanView_Folder, temp,
helfer As String
Dim Treffer As Boolean
Dim Bilder_Nr, Seiten_Anzahl, Bilder_je_Seite, Antwort, i, j,
breite, hoehe, posOben As Integer

posOben = 0

'Ordner mit Fotos aussuchen
Laufwerk = GetDirectory("Bitte Ordner wàhlen")


If Laufwerk = "" Then
Exit Sub


'Ordner in Variable packen
Set f = fs.GetFolder(Laufwerk)
Set fc = f.Files
'Temporàren Ordner anlegen
MkDir (Laufwerk & temp)
helfer = Laufwerk & temp
'Ordner nach Datien durchsuchen
For Each f1 In fc
CD_Folder = Laufwerk & "\" & f1.Name

'Auf JPG Bilder prüfen
If UCase(Right(CD_Folder, 4)) = ".JPG" Then
'Set g = fs.GetFolder(CD_Folder)
'Set gc = g.Files

'IrfanView Kommandozeile aurufen und Alle Bilder auf eine Größe
bringen...
Call Shell(IrfanView_Folder + "i_view32.exe " + CD_Folder
+ "/one /resample=(800,800) /dpi=(72,72) /jpgq… /aspectratio /
convert=" + helfer + f1.Name, vbNormalFocus)

'Die komprimierten Bilder in TEMP Ordner kopieren
fs.CopyFile helfer & f1.Name, ActivePresentation.Path &
"\" & Datum & "\" & User & "\"

Else
GoTo Ende

End If

Ende:
Next

'temporàre Dateien löschen

Kill (helfer & "*.*")

'temporàre Ordner löschen

RmDir (helfer)

'Verzeichnis anlegen um Bilder zu speichern

Verzeichnis = ActivePresentation.Path & "\" & Datum & "\" & User &
"\"
Bilder_Nr = 0
Seiten_Anzahl = 1

Set g = fs.GetFolder(Verzeichnis)
Set gc = g.Files

'Wieviel Bilder sollen auf die Folie?
Neue_Anzahl_Bilder:

Bilder_je_Seite = InputBox("Anzahl der Bilder pro Seite eingeben,
1, 2 oder 4 Bilder je Seite ?", 4)
'Folie entsprechend der Anzahl der Bilder ausrichten
Select Case Bilder_je_Seite
Case 1
With ActivePresentation.PageSetup
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationHorizontal
.NotesOrientation = msoOrientationHorizontal
End With
GoTo Bild_je_Seite_1
Case 2
With ActivePresentation.PageSetup
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationVertical
.NotesOrientation = msoOrientationVertical
End With
GoTo Bild_je_Seite_2
Case 4
With ActivePresentation.PageSetup
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationHorizontal
.NotesOrientation = msoOrientationHorizontal
End With
GoTo Bild_je_Seite_4
Case Else
GoTo Neue_Anzahl_Bilder
End Select
'Bilder auf die Folie schreiben
Bild_je_Seite_1:
For Each g1 In gc
Bilder_Nr = Bilder_Nr + 1

If Bilder_Nr > 1 Then
'neue Folie einfügen
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=Bilder_Nr,
Layout:=ppLayoutBlank).SlideIndex
Seiten_Anzahl = Seiten_Anzahl + 1
End If
'Bilddatei hinzufügen...
ActiveWindow.Selection.SlideRange.Shapes.AddPicture
(FileName:=Verzeichnis & g1.Name, LinkToFile:=msoFalse,
SaveWithDocument:=msoTrue, Left:0, Top:P).Select
'Bild auf Folie plazieren
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.8, msoFalse
.ScaleWidth 0.8, msoFalse
.Left = 20
.Top = 20
End With
Else
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.8, msoFalse
.ScaleWidth 0.8, msoFalse
.Left = 20
.Top = 20
End With
End If
Next


Bild_je_Seite_2:
For Each g1 In gc
Bilder_Nr = Bilder_Nr + 1

If Int((Bilder_Nr - 1) / 2) <> 0 And Int((Bilder_Nr - 1) / 2)
= (Bilder_Nr - 1) / 2 Then
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=(Int(Bilder_Nr / 2) + 1),
Layout:=ppLayoutBlank).SlideIndex
Seiten_Anzahl = Seiten_Anzahl + 1
End If

ActiveWindow.Selection.SlideRange.Shapes.AddPicture
(FileName:=Verzeichnis & g1.Name, LinkToFile:=msoFalse,
SaveWithDocument:=msoTrue, Left:0, Top:P).Select

If Int(Bilder_Nr / 2) <> Bilder_Nr / 2 Then

If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
posOben = (hoehe * 0.55) / 2 - (breite * 0.55) / 2
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.55, msoFalse
.ScaleWidth 0.55, msoFalse
.Left = 30 + posOben
.Top = 0 - posOben
End With
Else

With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.55, msoCTrue
.ScaleWidth 0.55, msoCTrue
.Left = 30
.Top = 0
End With
End If
Else
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
posOben = (hoehe * 0.55) / 2 - (breite * 0.55) / 2
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.55, msoCTrue
.ScaleWidth 0.55, msoCTrue
.Left = 30 + posOben
.Top = 365 - posOben
End With
Else

With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.55, msoCTrue
.ScaleWidth 0.55, msoCTrue
.Left = 30
.Top = 365
End With
End If
End If
Next


Bild_je_Seite_4:
For Each g1 In gc
Bilder_Nr = Bilder_Nr + 1

If Int((Bilder_Nr - 1) / 4) <> 0 And Int((Bilder_Nr - 1) / 4) (Bilder_Nr - 1) / 4 Then
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=(Int(Bilder_Nr / 4) + 1),
Layout:=ppLayoutBlank).SlideIndex
Seiten_Anzahl = Seiten_Anzahl + 1
End If

ActiveWindow.Selection.SlideRange.Shapes.AddPicture
(FileName:=Verzeichnis & g1.Name, LinkToFile:=msoFalse,
SaveWithDocument:=msoTrue, Left:0, Top:P).Select
If Int((Bilder_Nr + 3) / 4) = (Bilder_Nr + 3) / 4 Then 'oben
links
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
'posOben = hoehe / 2 - breite / 2
'posOben = posOben * 0.4
posOben = (hoehe * 0.4) / 2 - (breite * 0.4) / 2

With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 40
.Top = -40
End With

Else
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 0
.Top = 0

End With
End If
End If
If Int((Bilder_Nr + 2) / 4) = (Bilder_Nr + 2) / 4 Then 'oben
rechts
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
'posOben = hoehe / 2 - breite / 2
'posOben = posOben * 0.4
posOben = (hoehe * 0.4) / 2 - (breite * 0.4) / 2
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 405.75
.Top = -40
End With
Else
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 365.75
.Top = 0
End With
End If
End If
If Int((Bilder_Nr + 1) / 4) = (Bilder_Nr + 1) / 4 Then
'unten links
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
'posOben = hoehe / 2 - breite / 2
'posOben = posOben * 0.4
posOben = (hoehe * 0.4) / 2 - (breite * 0.4) / 2
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 40
.Top = 247.25

End With
Else
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 0
.Top = 274.25

End With
End If
End If
If Int(Bilder_Nr / 4) = Bilder_Nr / 4 Then 'unten rechts
If ActiveWindow.Selection.ShapeRange.Height >
ActiveWindow.Selection.ShapeRange.Width Then
ActiveWindow.Selection.ShapeRange.Rotation = 90
hoehe = ActiveWindow.Selection.ShapeRange.Height
breite = ActiveWindow.Selection.ShapeRange.Width
'posOben = hoehe / 2 - breite / 2
'posOben = posOben * 0.4
posOben = (hoehe * 0.4) / 2 - (breite * 0.4) / 2
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 405.75
.Top = 247.25

End With
Else
With ActiveWindow.Selection.ShapeRange
.ScaleHeight 0.4, msoCTrue
.ScaleWidth 0.4, msoCTrue
.Left = 365.75
.Top = 274.25

End With
End If
End If
Next

End Sub
 

Lesen sie die antworten

#1 Hans Werner Hofmann
17/01/2009 - 00:46 | Warnen spam
On Fri, 16 Jan 2009 05:02:41 -0800 (PST), Wazlav Gizycki
wrote:

Hallo,
8<
Dabei geht aber was schief. Ich dDrehe die Hochkant Bilder um 90°
damit z.B. vier Fotos auf eine Folie passen. Aber wenn ich die Bilder
gedreht habe, haben Sie eine andere Position auf der Folie als die,
die schon normal waren, obwohl ich immer die gleichen Koordinaten
verwende. Irgendiwe komme ich nicht weiter. Im Code könnt ihr sehen,
dass ich verschiedene Varianten ausprobiert habe.
Aber keine der Varianten Funktioniert richtig...

Wàre Cool wenn ihr mal drüber schauen würdet. Ich habe bisher nur VBA
in verbindung mit Access verwendet.



Vielleicht versuchst Du erst mal deutlich zu machen was für ein
Ergebnis Du eigentlich erwartest. Was glaubst DU was wir uns unter
einer anderen Position und unter einer normalen Position vorstellen
sollen
BTW:Was gefàllt Dir an der Fotoalbum-Funktion von 2007 nicht?

Gruß HW
Hans Werner Hofmann

Ähnliche fragen