Office: Makro für Bilddokumentation

Hallo,

folgendes Problem: ich möchte ein Makro erstellen, mit dem ich automatisch Bilder aus einem Ordner in das Worddokument einfügen kann und das die Bilder gleich so auf der Seite aufteilt, dass immer 4 Bilder auf eine A4-Seite passen. (Für Bilddokumentationen)
Was die Seitenformatierung und das Bilderauswählen und einfügen angeht, hab ich schon was. Aber wie kann man Word per Makro dazu bringen alle eingefügten Bilder gleich auf die A4-Seite zu verteilen??? (Denn auch die Anzahl ändert sich je nach Ordner).

Zusammenfassend soll das Makro folgendes tun:
1 Seite einrichten (A4 quer mit 2 Spalten)
2 Ordner mit Bildern auswählen lassen
3 Bilder einfügen
4 Bilder zu je 4 Stück auf eine A4 Seite aufteilen
5 pdf-Druck (um Datei zu komprimieren)

Hat jemand eine Idee???

LG

StephanMo

 

BITTE HELFT!!!

HILFFEEEEE!

Kann denn keiner helfen??

Ich habe mittlerweile ein Makro für einige Teile, aber das klappt nicht so gut
(Bei mehr als ca. 90 Bildern kommen Laufzeitfehler und das Makro bricht ab.

BITTE bitte helft mir!!!!

Sub Fotodokumentation()
'
' Fotodokumentation Makro
' Makro aufgezeichnet am 14.05.2009 von cm
'
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2.5)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
With ActiveDocument.PageSetup.TextColumns
.SetCount NumColumns:=1
.EvenlySpaced = False
.LineBetween = False
End With
ActiveDocument.PageSetup.TextColumns.Add Width:=CentimetersToPoints(12.47) _
, Spacing:=CentimetersToPoints(1.25), EvenlySpaced:=False
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Style = ActiveDocument.Styles("Standard")
Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(2.22) _
, Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Name = "Arial"
Selection.Font.Size = 12
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILLIN ", PreserveFormatting:=True
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Name = "Arial"
Selection.Font.Size = 8
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Dim strVerz As String
Dim strDName As String
strVerz = InputBox(("Pfad angeben ..."), "Alle Bilder aus Verzeichnis einfügen", _
"D:\Eigene Dateien\Eigene Bilder\")
If Right(strVerz, 1) <> "\" Then strVerz = strVerz & "\"
strDName = Dir(strVerz & "*.*") 'Typ anpassen (*.* für alle Typen)
If strDName <> "" Then
prgBilderEinfuegen strVerz, strDName
End If
Do While (strDName <> "")
strDName = Dir()
If strDName <> "" Then
prgBilderEinfuegen strVerz, strDName
End If
Loop
End Sub
Sub prgBilderEinfuegen(strVerz As String, strDName As String)
Selection.InlineShapes.AddPicture (strVerz & strDName), LinkToFile:=False, _
SaveWithDocument:=True
Selection.TypeParagraph
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Dim myIS As Word.InlineShape
Dim Prozent As Single

Prozent = 30 'Hier den Prozentwert eingeben!

For Each myIS In ActiveDocument.InlineShapes
myIS.ScaleHeight = Prozent
myIS.ScaleWidth = Prozent
Next myIS

End Sub


LG
StephanMo