Autofit Image to a Preset Cell

macropod · #6 06-02-2011, 03:02 AM

Hi Gareth,

As I'm sure you've found, over-sized images are reduced in size. So, it's really only the under-sized images that are the problem. Regardless, the following macro will fit all inlineshapes in all cells in all tables to the 'best fit' for the cells they're in.

Code:

Sub FitPics()
Application.ScreenUpdating = False
Dim Tbl As Table, iShp As InlineShape
With ActiveDocument
  For Each Tbl In .Tables
    For Each iShp In Tbl.Range.InlineShapes
      With iShp
        .LockAspectRatio = msoTrue
        .Height = .Range.Cells(1).Height
        If .Width > .Range.Cells(1).Width Then
          .Width = .Range.Cells(1).Width
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Note: As coded, the macro takes no account of cell border padding or any 'before/after' spacing for the paragraph they're attached to.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Adding Image into a excel cell and adding a hyperlink to the image	saravananiyyanar	Excel	3	05-04-2011 08:31 AM
How can I fill cell color starting from Cell D5 using Conditional formatting instead	Learner7	Excel	0	07-08-2010 05:50 AM
How can I make a cell color RED under the Today's date cell?	Learner7	Excel	2	07-08-2010 12:52 AM
Auto-populate an MS Word table cell with text from a diff cell?	dreamrthts	Word Tables	0	03-20-2009 01:49 PM
Table Autofit Behavior Default	Henri Blits	Word Tables	0	07-18-2006 03:49 PM