Afbeeldingen bewerken in VBA-word

[Anton2008]

Het automatisch inlezen van afbeeldingen (JPG) uit een standaard directory gaat ik het hebben wil (met 6 foto's per pagina), ik kan de ingelezen afbeeldingen niet bewerken.

normaal gesproken neem ik m'n acties op in een MACRO (als spiekbriefje, van hoe en wat). Echter een ingelezen bestand selecteren lukt niet als ik een macro aan het opnemen ben

Nu lukt het me wel om een InLineShapes te bewerken, maar dat wil ik niet, want dan kan ik niet de positie van de afbeelding bepalen.

bijgaand mijn procedure


Sub Fotos()
'dimensioneren
Dim intAantalPaginas As Integer
Dim intAantalFotos As Integer
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim strBestandsNaam(100) As String
Dim strResultaat As String
Const strPadNaam As String = "c:\FOTOS\"

'lezen bestanden
A = 1
strBestandsNaam(1) = Dir(strPadNaam & "*.jpg")
strResultaat = strResultaat & A & ") - " & strBestandsNaam(1) & vbCr

Do
A = A + 1
strBestandsNaam(A) = Dir()
strResultaat = strResultaat & A & ") - " & strBestandsNaam(A) & vbCr
Loop While strBestandsNaam(A) <> ""

intAantalFotos = A - 1
'intAantalFotos = 1
intAantalPaginas = Int(A / 6) + 1

'openen standaard document
ChangeFileOpenDirectory "C:\FOTOS\"
Documents.Open FileName:="""Foto 6 document.doc"""
Selection.MoveDown Unit:=wdLine, Count:=10

'inlezen van foto bestanden
For A = 1 To intAantalPaginas
For B = 1 To 6
C = ((A - 1) * 6) + B

'vanaf hier m.b.v. macro-opnemen verkregen (en dus alleen voor inlineshapes
Selection.InlineShapes.AddPicture FileName:=strPadNaam & strBestandsNaam(C), LinkToFile:=False, SaveWithDocument:=True

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InlineShapes(1).Fill.Visible = msoFalse
Selection.InlineShapes(1).Fill.Solid
Selection.InlineShapes(1).Fill.Transparency = 0#
Selection.InlineShapes(1).Line.Weight = 0.75
Selection.InlineShapes(1).Line.Transparency = 0#
Selection.InlineShapes(1).Line.Visible = msoFalse
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Height = 159.6
Selection.InlineShapes(1).Width = 212.6
Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
Selection.InlineShapes(1).PictureFormat.CropRight = 0#
Selection.InlineShapes(1).PictureFormat.CropTop = 0#
Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.MoveDown Unit:=wdLine, Count:=10

If C = intAantalFotos Then
B = 6
A = intAantalPaginas
End If
Next B
Next A

End Sub
[/SIZE][/SIZE]

 

[snb]

Maak een Worddocument met een tabel met 6 cellen.
Zet daarin de afbeeldingen
Pas de afmetingen aan met

Sub aanpas()
  For Each cl In ActiveDocument.Tables(1).Rows
    With cl.Cells(1).Range.InlineShapes(1)
      .Height = cl.Height
      .Width = cl.Cells(1).Width
    End With
    With cl.Cells(2).Range.InlineShapes(1)
      .Height = cl.Height
      .Height = cl.Cells(2).Height
    End With
  Next
End Sub

 

[Anton2008]

Via VBA de cellen aanpassen lukte niet zo snel

maar in het standaarddocumentje een tabel aanmaken, met vaste hoogte en breedte, en ergens het vinkje uitzetten (formaat aanpassen aan inhoud) werkt perfect

hiermee moet het zekers gaan lukken

dank :thumb: