#1
|
|||
|
|||
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 Thanks!
__________________
Backup your original file before doing any modification. |
#2
|
||||
|
||||
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 |
#3
|
|||
|
|||
Quote:
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. |
#4
|
|||
|
|||
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. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Filter or Lookup Formula to Organize Keywords | MKTGCLOUD | Excel | 8 | 11-28-2018 07:35 PM |
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 |