Microsoft Office Forums Organize shapes

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-30-2019, 05:00 PM
eduzs eduzs is offline Organize shapes Windows 10 Organize shapes Office 2010 32bit
Competent Performer
Organize shapes
 
Join Date: May 2017
Posts: 157
eduzs is on a distinguished road
Default Organize shapes

Hi!

I need to arrange shapes so that each figure is on a document page.


The shapes are from JPG which I drag and drop into the document (as inlineshapes).
I started with this code:

Code:
Sub ResizePic()

Dim x As Integer

With ActiveDocument.PageSetup
    .LeftMargin = CentimetersToPoints(1)
    .RightMargin = CentimetersToPoints(1)
    .TopMargin = CentimetersToPoints(1)
    .BottomMargin = CentimetersToPoints(1)
    sWidth = .PageWidth - .LeftMargin - .RightMargin
End With

For x = 1 To ActiveDocument.InlineShapes.Count
    ActiveDocument.InlineShapes(1).Width = sWidth
    ActiveDocument.InlineShapes(1).ConvertToShape
Next x

For x = 1 To ActiveDocument.Shapes.Count
    ActiveDocument.Shapes(x).WrapFormat.Type = wdWrapSquare
Next x

End Sub
After running the macro, I got all the stacked pictures remain in a single-page document, instead of 1 shape per page. I also need that the shapes fit to the document width (resize shape).

Thanks!
__________________
Backup your original file before doing any modification, test in a throwaway copy of your file.
Reply With Quote
  #2  
Old 04-30-2019, 09:14 PM
gmayor's Avatar
gmayor gmayor is offline Organize shapes Windows 10 Organize shapes Office 2016
Expert
 
Join Date: Aug 2014
Posts: 2,860
gmayor is just really nicegmayor is just really nicegmayor is just really nicegmayor is just really nice
Default

The images will adapt to the document width if the images are larger than the page width to start with, however smaller images will not.

The reason your code stacks the images is that you are converting them to shapes and adding a wrap option, for some reason which is not entirely clear, and then you are not repositioning the shapes. I see no reason to change them to shapes. The following will set your margins (though you could have done that before inserting the pictures) and will set the width to the width between the margins. As it is almost inevitable that there will be room for only one image on a page they will then be on separate pages.

Code:
Sub ResizePic()
Dim x As Integer
Dim lngWidth As Long
    With ActiveDocument.PageSetup
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(1)
        .TopMargin = CentimetersToPoints(1)
        .BottomMargin = CentimetersToPoints(1)
        lngWidth = .PageWidth - .LeftMargin - .RightMargin
    End With
    For x = 1 To ActiveDocument.InlineShapes.Count
        ActiveDocument.InlineShapes(x).Width = lngWidth
    Next x
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 05-01-2019, 03:48 AM
eduzs eduzs is offline Organize shapes Windows 10 Organize shapes Office 2010 32bit
Competent Performer
Organize shapes
 
Join Date: May 2017
Posts: 157
eduzs is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
The images will adapt to the document width if the images are larger than the page width to start with, however smaller images will not.

The reason your code stacks the images is that you are converting them to shapes and adding a wrap option, for some reason which is not entirely clear, and then you are not repositioning the shapes. I see no reason to change them to shapes. The following will set your margins (though you could have done that before inserting the pictures) and will set the width to the width between the margins. As it is almost inevitable that there will be room for only one image on a page they will then be on separate pages.
Thanks gmayor!

I did some improvements, the code below will proportionally scale the shape to fit page margins (width and height) and apply a rotation (only available in shapes).

Have any optimization suggestions? Thanks!

Code:
 Code under construction

Last edited by eduzs; 05-01-2019 at 07:21 PM.
Reply With Quote
  #4  
Old 05-03-2019, 04:31 PM
eduzs eduzs is offline Organize shapes Windows 10 Organize shapes Office 2010 32bit
Competent Performer
Organize shapes
 
Join Date: May 2017
Posts: 157
eduzs is on a distinguished road
Default

I use this code to insert images from a folder in a word document so I can print / read / save as a single document.

I did some adaptations, and here's the code that works to me (may not work or not suitable for everyone):
(I appreciate suggestions to optimize)
I JUST USE THIS CODE WITH A BLANK DOCUMENT.

Thanks.
Code:
Sub Add_images_from_folder()

Dim doc As Word.Document, fd As FileDialog, vItem As Variant, mg1 As Range, mg2 As Range, x As Integer
Dim sWidth As Double, sHeight As Double, sc As Double, scW As Double, scH As Double, Sca, Rot As Double

On Error Resume Next
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set doc = ActiveDocument
Application.ScreenUpdating = False

With doc.PageSetup
    .LeftMargin = CentimetersToPoints(1)
    .RightMargin = CentimetersToPoints(1)
    .TopMargin = CentimetersToPoints(1)
    .BottomMargin = CentimetersToPoints(1)
    sWidth = .PageWidth - .LeftMargin - .RightMargin
    sHeight = .PageHeight - .TopMargin - .BottomMargin
End With

With fd
    .Filters.Add "Images", "*.bmp; *.gif; *.jpg; *.jpeg; *.pdf; *.png", 1
    .FilterIndex = 1
    If .Show = -1 Then
        Rot = InputBox("Rotation (degress):", "Rotate the images?", 0)
        If Rot = vbNull Then Exit Sub
        Sca = MsgBox("Fit images to margins?", vbExclamation + vbYesNoCancel)
        If Sca = vbCancel Then Exit Sub
        For Each vItem In .SelectedItems
            Set mg2 = doc.Range
            mg2.Collapse wdCollapseEnd
            doc.InlineShapes.AddPicture FileName:=vItem, LinkToFile:=False, SaveWithDocument:=True, Range:=mg2
            Set mg1 = doc.Range
            mg1.Collapse wdCollapseEnd
            x = x + 1
            If Rot <> 0 Then
                doc.InlineShapes(x).ConvertToShape
                With doc.Shapes(1)
                    .IncrementRotation (Rot)
                    .ConvertToInlineShape
                    .Select
                End With
                With Selection
                    .Copy
                    .Delete
                    .PasteSpecial DataType:=14
                End With
            End If
            doc.InlineShapes(x).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            If Sca = vbYes Then
                With doc.InlineShapes(x)
                    scW = 1 + (sWidth - .Width) / .Width
                    scH = 1 + (sHeight - .Height) / .Height
                    If scW < scH Then sc = scW Else sc = scH
                    .LockAspectRatio = msoFalse
                    .Width = .Width * sc
                    .Height = .Height * sc
                End With
            End If
        Next vItem
    End If
End With

With doc.ActivePane.View.Zoom
    .PageColumns = 5
    .PageRows = 2
End With

Set fd = Nothing
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True

End Sub
__________________
Backup your original file before doing any modification, test in a throwaway copy of your file.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Organize shapes Filter or Lookup Formula to Organize Keywords MKTGCLOUD Excel 8 11-28-2018 07:35 PM
Organize shapes Best way to organize resources Steve. Project 3 05-17-2014 07:07 AM
Organize a shared mailbox with categories remmyMartin Outlook 0 04-03-2013 01:40 PM
Organize Sent mail/items outlookissues Outlook 0 05-13-2012 08:55 AM
organize files userman Excel 13 05-04-2012 03:49 PM


All times are GMT -7. The time now is 03:58 AM.


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