Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 12-09-2021, 01:53 AM
jameson jameson is offline Optimizing images in document and creating text boxes Windows 10 Optimizing images in document and creating text boxes Office 2019
Novice
Optimizing images in document and creating text boxes
 
Join Date: Dec 2021
Posts: 4
jameson is on a distinguished road
Default 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
Currently I'm stuck creating a text box for every image (position relative to the image) - Can anyone point me in the good direction?
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Optimizing images in document and creating text boxes 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
Optimizing images in document and creating text boxes Creating and Referencing Drop Down Text Boxes in VBA code cjkmarx Word VBA 1 12-12-2016 03:20 PM
Optimizing images in document and creating text boxes How to Wrap Text on Images in Text Boxes mrniceguy Word 1 02-16-2014 04:42 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:38 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft