PDA

Vollständige Version anzeigen : Mehrere Grafiken gleichzeitig einfügen


HarryH
06.09.2002, 08:05
Hallo!

Habe folgendes Problem. Es sollen aus einem Ordner alle vorhandenen Grafiken mit einem Arbeitsschritt in eine neue Präsentation eingefügt werden. Wobei jede Grafik auf einer neuen Folie eingefügt werden soll. Gibt es hierzu eine Lösung? Vielleicht hat ja schon jemand einen passenden VBA Code zur Hand. Es würde mich sehr freuen, da das manuelle Einfügen von teilweise hunderten Grafiken sehr mühsam ist. Danke schon mal im voraus.

Harry

jinx
06.09.2002, 22:02
<font size="2" face="Century Gothic">Moin, Harry,

die verwendete Version fehlt; ab PP2000 kannst Du den Makro-Rekorder nutzen, um zumindest einen Ansatz zum Vorgehen zu bekommen.

Willst Du die Bilder einfügen oder nur per Link auf die Folien packen? Haben die Bilder alle die gleichen Abmessungen oder müssen sie angepasst werden?</font>

<HarryH>
07.09.2002, 11:45
Hi Jinx,

vielen Dank für den Lösungsansatz. Ich nutze PP2000. Insofern könnte ich den Makrorekorder nutzen. Wie soll denn dann aber die Auswahl des Fotos aus dem Ordner erfolgen. Es kann ja kein Dateiname bei der Aufzeichnung verwendet werden, da dieser bei der nächsten Wiedergabe ja schon wieder anders ist. Die Grafiken sollen übrigens eigebunden werden. Die sind alle gleich groß. Eventuelle manuelle Anpassungen wären nach dem automatischen Einfügen nicht tragisch. Hauptsache, ich kann mir den Schritt sparen, da es bei einer konkreten Präsentation sich um mehr als 200 Grafiken handelt. Gibt es vielleicht nicht einen Lösungsansatz über eine VBA Prozedur? Bin in diesem Bereich absoluter Anfänger

<HarryH>
07.09.2002, 11:46
Hi Jinx,

vielen Dank für den Lösungsansatz. Ich nutze PP2000. Insofern könnte ich den Makrorekorder nutzen. Wie soll denn dann aber die Auswahl des Fotos aus dem Ordner erfolgen. Es kann ja kein Dateiname bei der Aufzeichnung verwendet werden, da dieser bei der nächsten Wiedergabe ja schon wieder anders ist. Die Grafiken sollen übrigens eigebunden werden. Die sind alle gleich groß. Eventuelle manuelle Anpassungen wären nach dem automatischen Einfügen nicht tragisch. Hauptsache, ich kann mir den Schritt sparen, da es bei einer konkreten Präsentation sich um mehr als 200 Grafiken handelt. Gibt es vielleicht nicht einen Lösungsansatz über eine VBA Prozedur? Bin in diesem Bereich absoluter Anfänger

<HarryH>
07.09.2002, 11:46
Hi Jinx,

vielen Dank für den Lösungsansatz. Ich nutze PP2000. Insofern könnte ich den Makrorekorder nutzen. Wie soll denn dann aber die Auswahl des Fotos aus dem Ordner erfolgen. Es kann ja kein Dateiname bei der Aufzeichnung verwendet werden, da dieser bei der nächsten Wiedergabe ja schon wieder anders ist. Die Grafiken sollen übrigens eigebunden werden. Die sind alle gleich groß. Eventuelle manuelle Anpassungen wären nach dem automatischen Einfügen nicht tragisch. Hauptsache, ich kann mir den Schritt sparen, da es bei einer konkreten Präsentation sich um mehr als 200 Grafiken handelt. Gibt es vielleicht nicht einen Lösungsansatz über eine VBA Prozedur? Bin in diesem Bereich absoluter Anfänger

jinx
07.09.2002, 18:11
<font size="2" face="Century Gothic">Moin, Harry,

da hast Du wohl das ein oder andere Mal zuviel auf den Knopf Beitrag beantworten gedrückt...

Bei mir funktioniert ein Vorgehen mit folgendem Makro, das in ein allgemeines Modul eingefügt wurde:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Sub</span> HarryH()
<span class="REM">'/// Der erste Teil des Makros stammt zwar aus Excel, liest aber aus einem</span>
<span class="REM">'/// vorgegebenen Verzeichnis (hier: C:\Temp) alle Dateien eines bestimmten</span>
<span class="REM">'/// Typs in ein Array ein</span>
<span class="TOKEN">Dim</span> FileArray()
<span class="TOKEN">Dim</span> i%, n%
<span class="TOKEN">Dim</span> Extension$, dName$
<span class="TOKEN">Const</span> Ordner = &quot;C:\TEMP&quot;
<span class="REM">'/// Auslesen des aktuellen Verzeichnisses</span>
Pfad = Application.ActivePresentation.Path
<span class="REM">'/// Hier die Dateierweiterung festlegen</span>
Extension = &quot;*.jpeg&quot;
ChDrive Left(Ordner, 1)
ChDir Ordner
dName = Dir(Extension)
<span class="TOKEN">Do</span> <span class="TOKEN">While</span> dName &lt;&gt; &quot;&quot;
n = n + 1
<span class="TOKEN">ReDim</span> <span class="TOKEN">Preserve</span> FileArray(1 <span class="TOKEN">To</span> n)
FileArray(n) = dName
dName = Dir()
<span class="TOKEN">Loop</span>
<span class="REM">'/// Wechsel zur&uuml;ck auf das Ausgangsverzeichnis</span>
ChDrive Left(Pfad, 1)
ChDir Pfad
<span class="REM">'/// Abarbeiten des Arrays, dabei wird immer an zweiter Stelle eine neue Folie angelegt und</span>
<span class="REM">'/// das Bild eingef&uuml;gt (nicht per Link, es erfolgt keine Gr&ouml;&szlig;enanpassung)</span>
<span class="TOKEN">For</span> i = 1 <span class="TOKEN">To</span> n
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add _
(Index:=2, Layout:=ppLayoutBlank).SlideIndex
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Ordner _
&amp; &quot;\&quot; &amp; FileArray(i), LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=162, Top:=-29, Width:=397, Height:=600).Select
<span class="TOKEN">Next</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

<font size="1" face="Century Gothic">Moderatorenanmerkung: die Überarbeitung dieses Beitrages ist im Zuge der Arbeiten zu sehen, die durch den Wechsel der Forensoftware zum 01.01.2003 verursacht wurden.

Es wurden in diesem Beitrag Links korrigiert, die auf falsche Adressen zeigten...</font>

HarryH
09.09.2002, 07:59
Hi Jinx,

vielen Dank für Deine Hilfe. Das Makro funktioniert wunderbar und das manuelle Einfügen kann zukünftig entfallen. Nochmals herzlichen Dank, Du hast mir sehr geholfen.

Schönen Tag noch!

Gruß Harry

Hennes
09.04.2004, 19:50
Hallo,
also das ist ja ein guter beitrag, aber gibt es vielleicht noch die möglichkeit den ordner per dialogfenster auszuwählen?
wäre cool wenn das auch noch ginge vielen dank!

jinx
12.04.2004, 08:04
<font size="2" face="Century Gothic">Moin, Hennes,

vielleicht siehst Du Dir für die Nachfrage bitte einmal Grafik einfügen mit Dateiabfrage (http://www.ms-office-forum.net/forum/showthread.php?s=&threadid=105406) an oder verwendest etwas in der folgenden Art (Code-Beispiel von Nepumuk aus dem Herber-Forum), was eventuell noch angepasst werden muss:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
<span class="TOKEN">Dim</span> NeuOrdner <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Type</span> InfoT
hwnd <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
Root <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
DisplayName <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
Title <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
Flags <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
FName <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
lParam <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
Image <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">End</span> <span class="TOKEN">Type</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> SHBrowseForFolder <span class="TOKEN">Lib</span> &quot;shell32&quot; (lpbi <span class="TOKEN">As</span> InfoT) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> CoTaskMemFree <span class="TOKEN">Lib</span> &quot;ole32&quot; (<span class="TOKEN">ByVal</span> hMem <span class="TOKEN">As</span> <span class="TOKEN">Long</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> lstrcat <span class="TOKEN">Lib</span> &quot;kernel32&quot; <span class="TOKEN">Alias</span> &quot;lstrcatA&quot; _
(<span class="TOKEN">ByVal</span> lpStr1 <span class="TOKEN">As</span> String, <span class="TOKEN">ByVal</span> lpStr2 <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> SHGetPathFromIDList <span class="TOKEN">Lib</span> &quot;shell32&quot; _
(<span class="TOKEN">ByVal</span> pList <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> lpBuffer <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> FindWindow <span class="TOKEN">Lib</span> &quot;user32&quot; <span class="TOKEN">Alias</span> &quot;FindWindowA&quot; _
(<span class="TOKEN">ByVal</span> lpClassname <span class="TOKEN">As</span> String, <span class="TOKEN">ByVal</span> lpWindowName <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Public Sub</span> Ordner_suchen()
NeuOrdner = GetAOrdner
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Private Function</span> GetAOrdner() <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> xl <span class="TOKEN">As</span> InfoT, IDList <span class="TOKEN">As</span> Long, RVal <span class="TOKEN">As</span> Long, FolderName <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">With</span> xl
.hwnd = FindWindow(&quot;xlmain&quot;, vbNullString)
<span class="REM">' .hwnd = FindWindow(&quot;&quot;, &quot;Auswahl&quot;) ' aus einer Userform mit Caption Auswahl</span>
.Title = lstrcat(&quot;Bitte w&auml;hlen Sie ein Verzeichnis&quot;, &quot;&quot;)
.Flags = 1
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
IDList = SHBrowseForFolder(xl)
<span class="TOKEN">If</span> IDList &lt;&gt; 0 <span class="TOKEN">Then</span>
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
GetAOrdner = FolderName
<span class="TOKEN">End</span> <span class="TOKEN">Function</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>

Hennes
14.04.2004, 20:12
ja wahnsinn, vielen dank! so habe ich mir das vorgestellt und es ist ja auch ohne änderungen einzufügen!
sagt mal, woher kann man das alles wissen?
gruss hennes

beth
16.04.2004, 20:54
Hi, habe alles so gemacht wie hier beschrieben, bekomme aber ständig die Fehlermeldung

"Fehler beim Kompilieren
Nach End Sub, End Function, oder End Property können nur Kommentare stehen"

Wo steckt der Fehler? Bin völliger Anfänger, möchte aber zahlreiche Grafikdateien in ein Worddokument einfügen (perMakro). Da der Speicherpfad ständig ein anderer ist, sollte auch eine Ordnerabfrage (Auswahlfenster mit Verzeichnisbaum) erfolgen. Wie geht das?


Option Explicit
Dim NeuOrdner As String
Private Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
' .hwnd = FindWindow("", "Auswahl") ' aus einer Userform mit Caption Auswahl
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End Function

Sub ordner()
Option Explicit
Dim NeuOrdner As String
Private Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
' .hwnd = FindWindow("", "Auswahl") ' aus einer Userform mit Caption Auswahl
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End Function

jinx
17.04.2004, 20:44
<font size="2" face="Century Gothic">Moin, beth, Du bist hier im Powerpoint- und nicht im Word-Forum Du hast es bestimmt nicht so gemacht, wie es hier beschrieben wurde, denn Du hast zumindest einige eigene Veränderungen (bewußt oder unbewußt) vorgenommen: zumindest das Option Explicit in Sub Ordner() muss weg, und die allgemeinen Anweisungen sollten davor in einem allgemeinen Modul stehen. Ein Anhang zur Verdeutlichung wäre vielleicht ratsam...</font>

hugolee
30.06.2004, 08:32
Hallo jinx!!!

Ich habe den Code Deines Makros genau so übernommen!


Leider funktioniert das nicht wie gewünscht!

Muss dazu sagen, dass ich blutiger anfänger bin.
Habe also dieses Makro erstellt.
Einer Präsentation mit einer ganz leeren Seite, SONST NIX!
Dann bin ich auf "Makro ausführen", hab mein Makro ausgewählt und es passiert NIX!

Noch ne Frage!
bei der Zeile
ActiveWindow.View.... hab ich durch das Kopieren 2 zusammenhängende Zeilen (durch _ getrennt)
ActiveWindow.Selection.... hab ich durch das Kopieren 3 zusammenhängende Zeilen (durch _ getrennt)

...könnte es daran liegen.

Oder rufe ich das Makro falsch auf??

DANKE für die Hilfe
hugolee


ich arbeite mit PP2000

hugolee
30.06.2004, 08:54
Die Dateien haben bei mir die Extention ".jpg"
im Code wird nach ".jpeg" abgefragt!



...wie sag ich immer:
"Wer lesen und schreiben kann ist klar im Vorteil"

hugolee

Ute-S
30.06.2004, 11:19
Hallo Hugolee,

statt eines Makros kannst Du Dir bei Microsoft auch das Photoalbum-AddIn herunterladen (URL habe ich gerade nicht zur Hand, müßte bei den Downloads aber zu finden sein).

Damit kannst Du aus mehreren Bildern eine neue Präsentation erstellen. In PowerPoint 2002 und 2003 ist diese Funktion dann standardmäßig unter "Einfügen | Grafik" vorhanden.

Ein Tutorial dazu haben wir für die Abonnenten des kostenlosen monatlichen PowerPoint-Newsletters erstellt, den Du unter www.ppt-user.de bestellen kannst.

Viele Grüße
Ute

hugolee
30.06.2004, 11:57
Hallo!

Also ich habe den CODE von jinx jetzt so modifiziert, dass die Bilder in der richtigen Reihenfolge eingefügt werden.
Bisher war das letzte dann immer auf der ersten bzw. zweiten Folie (also genau umgekehrt)
Ok, das ist nur Kosmetik!!!

Wie bekomme ich es aber hin, dass die Bilder "mittig" eingefügt werden, sowohl horizontal auls auch vertikal?

Was ist bei unterschiedlichen Bildgrößen?
Bisher wird eine feste Größe vorgegeben, was die Bilder verzerren kann!


ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Ordner & "\" & FileArray(i), LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=162, Top:=-29, Width:=397, Height:=600).Select

Hat da jemand nen Tipp?

Gruß
hugolee