![]() |
#1
|
|||
|
|||
![]()
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. ![]() 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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
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 |
![]() |
cjkmarx | Word VBA | 1 | 12-12-2016 03:20 PM |
![]() |
mrniceguy | Word | 1 | 02-16-2014 04:42 PM |