plaatjes in Word via VBA

[cbhonda]

Private Sub cmdRpt_Click()
Dim wrdApp As Word.Application
Dim wrdShape As Word.Shapes
Dim i As Integer
Dim d As Integer
Dim lngCols As Long
Dim strTitel As String
Dim strTemp As String
Dim fotoNaam as String

Set wrdApp = New Word.Application
lngcols=4
fotoNaam="test.jpg"
wrdApp.Documents.Add

With wrdApp
'teken tabel
    .ActiveDocument.Tables.Add .Selection.Range, 1, lngCols, wdWord9TableBehavior, wdAutoFitContent
    .Selection.Tables(1).AutoFormat Format:=wdTableFormatSimple1, ApplyBorders _
        :=False, ApplyShading:=False, ApplyFont:=True, ApplyColor:=True, _
        ApplyHeadingRows:=False, ApplyLastRow:=False, ApplyFirstColumn:=False, _
        ApplyLastColumn:=False, AutoFit:=True
for i = 1 to 10
    .Selection.TypeText Text:="titel"
    'groepeer de cellen bij de titel
    .Selection.MoveRight Unit:=wdCharacter, Count:=lngCols, Extend:=wdExtend
    .Selection.Cells.Merge
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    'nieuwe rij en de cellen terug splitsen
    .Selection.InsertRowsBelow 1
    .Selection.Collapse Direction:=wdCollapseStart
    .Selection.Cells.Split NumRows:=1, NumColumns:=lngCols, MergeBeforeSplit:=False
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
	
	for d = 1 to 7
            Set wrdShape = .ActiveDocument.Shapes
            wrdShape.AddPicture CurrentProject.Path & fotoNaam, True, True, , , , , wrdApp.Selection.Range
            wrdShape.Range(1).LockAspectRatio = msoFalse
            wrdShape.Range(1).width = 100
            wrdShape.Range(1).height = 100
            wrdShape.Range(1).ConvertToInlineShape
            DoEvents
            Set wrdShape = Nothing

            .Selection.TypeText Text:=vbCrLf & "Dit is txt onder de foto"
            .Selection.MoveRight Unit:=wdCell
	next d
        
'nadat alle foto's geplaatst zijn springen we naar nieuwe regel
'om de titel te plaatsen
	.Selection.InsertRowsBelow 1
next i
End With

    wrdApp.Visible = True
    wrdApp.Activate
    Set wrdApp = Nothing
End Sub

Normaal worden de locatie ea parameters uit een database gehaald, maar dat is niet echt van belang.

Deze code zorgt ervoor dat er foto's in een tabel worden geplaatst. Met telkens een titel en een omschrijving onder de foto (is nu wel steeds dezelfde foto, titel en omschrijving).
Wanneer ik dit doe met enkele foto's werkt het goed maar wanneer ik dit met 100 foto's doe staan er enkele foto's tussen op hun ware grootte. Heb er al een vertragingslus (met DoEvents) tussen geplaatst om zo Word meer rekentijd te geven zonder resultaat.

 

[cbhonda]

?!!Opgelost?!!

Niet echt nee.