 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Word / Programming / August 2006VBA to re-size all (inline) images in a document?
I need to regularly copy/paste records from a proprietary net-based program, into Word. The records include a mix of text and, at irregular intervals, images of various sizes and shapes. The problem is that, although the images are inline, many of them are oversized, extending well beyond the margins. (I realize this may sound unusual, with inline images. It might have something to do with the way that, as I understand it, the original program downloads the images from a different server than the source of the text, then inserts them into the records, inline, as links, which then appear as images in the program -- and in Word -- if the user is online. I can email an example, if this would help. I usually break the links to save the images into the Word file, so that the documents can be emailed with images included, but this does not fix the oversized-image problem.) I know that there are non-VBA methods to re-size each image. But sometimes there are hundreds of images in each set of records, so that manual re-sizing obviously becomes tedious, time-consuming and frustrating. Is it possible (especially for a VBA-dummy like me) to devise a VBA that would automatically re-size all of the images in a document, all to a selected width? (or, to shrink just the oversized images to a selected maximum width)? Thanks for any advice. Hi Ted, no problem, except for distorsion(!!!). Sub Test504() Dim oInl As InlineShape For Each oInl In ActiveDocument.InlineShapes oInl.Height = 100 oInl.Width = 100 Next End Sub or Sub Test504() Dim oInl As InlineShape For Each oInl In ActiveDocument.InlineShapes oInl.Height = oInl.Height / 10 oInl.Width = oInl.Height / 10 Next End Sub  SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Hi Helmut, Thank you for your help. Unfortunately, I am, a true beginner! I have used Word for years, but I have never created a Word macro or used a VBA editor. Can you please refer me to some basic instructions on how to use the commands that you kindly posted? > Hi Ted, > [quoted text clipped - 25 lines] > Win XP, Office 2003 > "red.sys" & Chr$(64) & "t-online.de" Hi Ted, see: http://www.gmayor.com/installing_macro.htm http://word.mvps.org/FAQs/MacrosVBA/VBABasicsIn15Mins.htm http://word.mvps.org/FAQs/MacrosVBA/UsingRecorder.htm http://word.mvps.org/faqs/macrosvba/ModifyRecordedMacro.htm SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Thank you, Helmut. I appreciate you giving me the chance to learn a little bit about this. I was able to create macros from what you gave me, but unfortunately the distortion is a big problem. I was hoping there was a way to make a macro that would maintain each image's original proportions or shape, while re-setting the width to a fixed (or a maximum) size, such as 6 inches. The problem is that the images, as I receive them, are all different sizes and shapes. Thanks again. > Hi Ted, > [quoted text clipped - 7 lines] > > http://word.mvps.org/faqs/macrosvba/ModifyRecordedMacro.htm Hi Ted, it needs a bit af mathematics to do that: Sub Test504y() Dim oInl As InlineShape Dim factor As Single For Each oInl In ActiveDocument.InlineShapes factor = InchesToPoints(6) / oInl.Width oInl.Height = InchesToPoints(6) oInl.Width = oInl.Width * factor Next End Sub SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" ... or the other way round: Sub Test504z() Dim oInl As InlineShape Dim factor As Single For Each oInl In ActiveDocument.InlineShapes factor = InchesToPoints(6) / oInl.Height oInl.Width = InchesToPoints(6) oInl.Height = oInl.Height * factor Next End Sub HTH SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Sorry, Helmut, both of these also distort the images. Is there a way to maintain the original aspect ratio, and set the exact (or the maximum) width, while letting the height be adjusted automatically to maintain the aspect ratio? The original images are never too tall for the page, but they are often too wide. Thanks... Here's a bit of code from an application which in part, inserts a logo into the cell of a table and then adjusts the size, while maintaining the aspect ratio so that it fits in the cell. 'Insert Logo on Title Page myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.Delete myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath 'Adjust size of logo to match avalable space oheight = myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1).Height owidth = myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1).Width If oheight < InchesToPoints(2) Then With myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1) .Height = InchesToPoints(2) .Width = owidth * InchesToPoints(2) / oheight End With End If oheight = myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1).Height owidth = myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1).Width If owidth > InchesToPoints(2.85) Then With myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range.InlineShapes(1) .Width = InchesToPoints(2.85) .Height = oheight * InchesToPoints(2.85) / owidth End With End If SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Sorry, Helmut, both of these also distort the images. > [quoted text clipped - 4 lines] > > Thanks... I appreciate your response, Doug, but I'm not able to adapt this as needed. > Here's a bit of code from an application which in part, inserts a logo > into the cell of a table and then adjusts the size, while maintaining the [quoted text clipped - 45 lines] >> >> Thanks... Hi Ted, to the best of my kowledge, Sub Test504z() Dim oInl As InlineShape Dim factor As Single Dim RatioStart As Single Dim RatioEnd As Single For Each oInl In ActiveDocument.InlineShapes RatioStart = oInl.Height / oInl.Width factor = InchesToPoints(6) / oInl.Height oInl.Width = InchesToPoints(6) oInl.Height = oInl.Height * factor RatioEnd = oInl.Height / oInl.Width If RatioStart <> RatioEnd Then MsgBox "no" Else MsgBox "yes" End If Next End Sub I get some no's for the first run of the macro, maybe due to rounding issues, but then never after. Maybe somebody else knows better. SignatureGruß Helmut Weber, MVP WordVBA "red.sys" & chr$(64) & "t-online.de" Win XP, Office 2003 (US-Versions) Thanks, Helmut. Unfortunately this is still changing the aspect ratio. I appreciate your ideas and your time anyway. > Hi Ted, > [quoted text clipped - 24 lines] > > Maybe somebody else knows better. It just occurred to me that if I describe how I do it manually, this might suggest to a VBA expert how to do the same thing with a Macro: 1) Click on the first oversized image 2) Format | Picture 3) On the Size tab, Delete the entry in the Height column, and LEAVE IT BLANK. In the Width column, type 6. Leave everything else on the Size tab at the defaults: Height and width scales 100%, "Lock aspect ratio" and "Relative to original picture size" selected. 4) Click OK. 5) Scroll down to the next oversized image, click on it, then hit F4 (Repeat). Continue these steps until all oversized images are shrunk. Note, when I OK to resize the first image, I see that the Height field on the Size tab gets populated at the last moment. Nevertheless, I find that this Height is not part of what gets repeated, for the other images, when I hit F4. Instead, F4 just repeats the Width setting, adjusting the height to fit the aspect ratio. This works fine, but is still much more time-consuming, for documents with many images, than a Macro would be. I hope this helps. Thanks very much. > Hi Ted, > [quoted text clipped - 24 lines] > > Maybe somebody else knows better. To retain the original proportions try this: Code ------------------- Sub ResizeWidth() Dim oInl As InlineShape For Each oInl In ActiveDocument.InlineShapes If oInl.Width > InchesToPoints(6) Then oInl.Width = InchesToPoints(6) oInl.ScaleHeight = oInl.ScaleWidth End If Next End Su ------------------- -- skatonn Posted from - http://www.officehelp.i Hooray! This works perfectly! Thank you!!! And thanks, also, to Helmut and to Doug, for your thoughts, your time, your training and your input on solving this puzzle. > To retain the original proportions try this: > [quoted text clipped - 14 lines] > skatonni > Posted from - http://www.officehelp.in |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.