Optimizing images in document and creating text boxes

[jameson]

Hello Everyone,




I found this forum through some search engine hits!


Currently I'm trying to create a macro which resizes images (to equal width), create a little black border, compress all images and and a text box for every image image generated.


Currently this is what i made so far (with subroutines):

Sub AOptimize()

Dim answer As Integer
 
answer = MsgBox("Optimize document?", vbQuestion + vbYesNo + vbDefaultButton2, "Optimize (C) L. Zwanikken")
    
If answer = vbYes Then
    Call CompressPics
    Call ResizePics
    Call Done
Else
  MsgBox "Aborted"
End If
End Sub
Sub ResizePics()
     Dim shp As Shape
     Dim ish As InlineShape
     For Each shp In ActiveDocument.Shapes
         Select Case shp.Type
             Case msoPicture, msoLinkedPicture
                 shp.Line.Style = msoLineSingle
                 With shp.Line
                    .Style = msoLineSingle
                    .Weight = 1
                    .ForeColor = wdColorBlack
                 End With
         End Select
     Next shp
     For Each ish In ActiveDocument.InlineShapes
         Select Case ish.Type
             Case wdInlineShapePicture, wdInlineShapeLinkedPicture
                 With ish.Line
                    .Style = msoLineSingle
                    .Weight = 1
                    .ForeColor = wdColorBlack
                 End With
         End Select
     Next ish

    Dim i As Long
    With ActiveDocument
    For i = 1 To .InlineShapes.Count
        With .InlineShapes(i)
            .Height = 161
            .Width = 300
            .LockAspectRatio = True
        End With
    Next i
End With
End Sub
Sub CompressPics()
    With Application.CommandBars.FindControl(ID:=6382)
        SendKeys "%A%W{Enter}"
        .Execute
    End With
End Sub
Sub CreateTextBox()
    Dim Box As Shape
    Set Box = ActiveDocument.Shapes.AddTextbox( _
        Orientation:=msoTextOrientationHorizontal, _
        Left:=425, Top:=150, Width:=100, Height:=50)

        Box.TextFrame.TextRange.Text = "Beschrijving hier"
End Sub
Sub Done()
MsgBox ("Optimizing document done!")
End Sub

Currently I'm stuck creating a text box for every image (position relative to the image) - Can anyone point me in the good direction?