#1
|
|||
|
|||
Optimizing images in document and creating text boxes
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): Code:
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 |
#2
|
||||
|
||||
It would be simpler if you used a two column fixed width table. Insert your images in the first column and they will (if they are larger) shrink to the column width. You can insert text boxes in the corresponding cells of the second column, set the wrap to inline with text and set the cell format to horizontally and vertically centred. Add borders to cells as required.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
||||
|
||||
You should resize the pictures before compressing them. The compression relates to the size of the graphic on the page since it is changing the resolution in pixels per inch. If you resize after compressing you are going to get either unacceptable quality or too large a file size.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#4
|
|||
|
|||
Quote:
Ahh thanks will change it Quote:
Great idea! But how do i archive this? |
#5
|
||||
|
||||
Your AOptimize subroutine calls the other subs in the wrong order. Just swap the order of these lines
Code:
If answer = vbYes Then Call CompressPics Call ResizePics Call Done Else
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
Thanks, but does anyone know how to create a text box for every image?
OR Create a (invisible) table (2x) where we can input text? |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Need help creating a document with 365 images, with a day of the year 2018 captioned on each image. | caarodriguez | Word VBA | 11 | 11-04-2017 09:40 PM |
Moving Text Boxes & Images Off Page MS Word 2016 | suilenroc | Drawing and Graphics | 0 | 08-24-2017 10:30 AM |
Copy each slide text boxes and images to Word | leaning | PowerPoint | 1 | 08-08-2017 06:42 AM |
Creating and Referencing Drop Down Text Boxes in VBA code | cjkmarx | Word VBA | 1 | 12-12-2016 03:20 PM |
How to Wrap Text on Images in Text Boxes | mrniceguy | Word | 1 | 02-16-2014 04:42 PM |