Hi =?Utf-8?B?U0Nyb3dsZXk=?=,
The only other possibility would be a macro that would basically do this:
- display a "file picker" dialog box
- process the selection, file by file
- inserting each picture
- prompting for a caption
- and inserting the caption
I set something up like this a few years ago, when I wrote a book for the
German market. There were two different tasks. The first lets you select
multiple pictures, then formats them as they're inserted. The second puts
individual pictures into frames (rather than just putting them inline) and
captions them. Perhaps you can adapt these procedures to your purposes. Copied
below my signature.
MSWord 2003 - I am inserting 183 photos into a report. I have enabled the
automatic caption to insert with the photos. Here's the problem: I
Insert/Picture/From File - select all the photos to be inserted and click
Insert. All the photos are there and all the captions are at the end of the
document and not with the photo. I double checked that I have "in-line with
text" selected under Tools/Options/Edit/Insert/Paste Pictures.
If you have a simpler way to insert multiple pictures all at once and have
them sized uniformally (i.e. 3 x 4) please share your knowledge. This is
taking way too long.
Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org
This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail
Option Explicit
Sub BildPos()
' Dialogfeld Erweitertes Layout für Grafiken einblenden.
If Selection.Type = wdSelectionShape _
Or Selection.Type = wdSelectionInlineShape Then
SendKeys "(^+){Tab}%W"
Dialogs(wdDialogFormatDrawingObject).Show
ElseIf Selection.Type = wdSelectionFrame Then 'Positionsrahmen
Dialogs(wdDialogFormatFrame).Show
End If
End Sub
Sub MehrereBilderEinfuegen()
'Mehrere Bilddateien in einem Dialogfeld wählen,
'einfügen, und formatieren.
Dim rng As Word.Range, szDateiPfad As String
Dim dlg As FileDialog, fdfs As FileDialogFilter
Dim dlgFilters() As Variant, vrtGewaehltesBild As Variant
Dim lFilter As Long
'Standardpfadangabe für Grafikdateien festlegen.
szDateiPfad = "%UserProfile%\Eigene Dateien\Eigene Bilder\"
Set rng = Selection.Range
'Dialogfeld für Dateiauswahl initialisieren.
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
'Dialogfeld einblenden
With dlg
'Schaltfläche Beschriftung
.ButtonName = "Bilder einfügen"
'Dialogfeld Beschriftung
.Title = "Bilder wählen und einfügen"
.InitialFileName = szDateiPfad
'Miniaturansicht (nur für Windows 2000 oder XP)
.InitialView = msoFileDialogViewThumbnail
'Vorhandene Filterliste festhalten.
If .Filters.Count > 0 Then
ReDim dlgFilters((.Filters.Count - 1), 1)
For Each fdfs In .Filters
dlgFilters(lFilter, 0) = fdfs.Description
dlgFilters(lFilter, 1) = fdfs.Extensions
lFilter = lFilter + 1
Next fdfs
End If
'Neue Filterliste erstellen.
If .Filters.Count > 0 Then .Filters.Delete
.Filters.Add Description:="Bilder", Extensions:="*.gif, *.tiff, *.jpg,
*.bmp)"
'Auswahl mehrerer Dateien zulassen.
.AllowMultiSelect = True
'Wenn der Benutzer nicht abbricht
If .Show = -1 Then
rng.Text = " "
Set rng = rng.Parent.Bookmarks.Add(Name:="Bilder",
Range:=rng).Range
'Jede Bilddatei in den Bereich einfügen.
For Each vrtGewaehltesBild In .SelectedItems
rng.Parent.InlineShapes.AddPicture _
FileName:=vrtGewaehltesBild, Range:=rng
rng.Collapse wdCollapseStart
Next vrtGewaehltesBild
'Alle Bilder formatieren.
Set rng = rng.Bookmarks(1).Range
MehrereBilderFormatieren rng
rng.Select
rng.Bookmarks(1).Delete
rng.Characters(1).Delete
End If
'Filterliste wieder herstellen.
If .Filters.Count > 0 Then .Filters.Delete
On Error Resume Next
For lFilter = LBound(dlgFilters) To UBound(dlgFilters)
.Filters.Add Description:=dlgFilters(lFilter, 0), _
Extensions:=dlgFilters(lFilter, 1)
Next lFilter
End With
End Sub
Sub MehrereBilderFormatieren(rng As Word.Range)
Dim iShp As InlineShape, shp As Shape, sPictName As String
For Each iShp In rng.InlineShapes
iShp.Width = CentimetersToPoints(5)
iShp.Height = CentimetersToPoints(5)
Set shp = iShp.ConvertToShape
shp.WrapFormat.Type = wdWrapSquare
shp.Select
sPictName = InputBox("Dem Bild einen Namen geben:")
If sPictName <> "" Then shp.Name = sPictName
With rng.Parent.PageSetup
shp.Left = .PageWidth - .LeftMargin - shp.Width
End With
Next iShp
End Sub
Sub AlleBilderInMarkierungFormatieren()
Dim rng As Range, iShp As InlineShape, shp As Shape
Set rng = Selection.Range
For Each iShp In rng.InlineShapes
iShp.Width = CentimetersToPoints(5)
iShp.Height = CentimetersToPoints(5)
Set shp = iShp.ConvertToShape
shp.WrapFormat.Type = wdWrapSquare
With rng.Parent.PageSetup
shp.Left = .PageWidth - .LeftMargin - shp.Width
End With
Next iShp
End Sub
Sub EingefuegtesShapeErfassen()
Dim rng As Word.Range, shp As Word.Shape
Set rng = Selection.Range
rng.PasteSpecial Placement:=wdFloatOverText, DataType:=wdPasteMetaPicture
Set shp = rng.ShapeRange(1)
Debug.Print shp.Name
End Sub
Sub GrafikInPosRahmenMitBeschriftung()
Dim szBild As String, lWahl As Long, lOK As Long
Dim bLinkToFile As Boolean, bSaveWithDoc As Boolean
Dim ils As Word.InlineShape, frm As Word.Frame
'Die Markierung darf/soll nicht in einer Tabelle, Positionsrahmen o.ä.
stehen.
If (Selection.Type <> wdSelectionIP And Selection.Type <>
wdSelectionNormal) _
Or Selection.Information(wdWithInTable) Or _
Selection.Information(wdInEndnote) Or
Selection.Information(wdInFootnote) Then
MsgBox "Die Markierung muss im Text stehen."
Exit Sub
End If
'Bild Dateiname, und Art der Einfügung
With Dialogs(wdDialogInsertPicture)
lOK = .Display
lWahl = .LinkToFile
szBild = .Name
End With
'Wenn nicht "Einfügen" gewählt wurde, abbrechen.
If lOK <> -1 Then Exit Sub
'Feststellen, ob Bild verknüpft und/oder im Dokument zu speichern ist.
Select Case lWahl
Case 0
bLinkToFile = False
bSaveWithDoc = True
Case 1
bLinkToFile = True
bSaveWithDoc = True
Case 2
bLinkToFile = True
bSaveWithDoc = False
Case Else
End Select
'Bild einfügen...
Set ils = ActiveDocument.InlineShapes.AddPicture(FileName:=szBild, _
LinkToFile:=bLinkToFile, SaveWithDocument:=bSaveWithDoc, _
Range:=Selection.Range)
'...und markieren.
ils.Select
'Positionsrahmen um die Markierung einfügen...
Set frm = Selection.Frames.Add(Range:=Selection.Range)
'...und rechts ausrichten.
frm.HorizontalPosition = wdFrameRight
'Neuen Absatz für die Beschriftung nach dem Bild einfügen.
Selection.Collapse wdCollapseEnd
Selection.Text = vbCr
'Benutzer für die Beschriftung auffordern.
Dialogs(wdDialogInsertCaption).Show
End Sub
