Insert image into Word Table cell without changing cell size

[sharky12345]

I'm using this to add a picture to a Word Table cell;

oDoc.Tables(1).Cell(1, 2).Range.InlineShapes.AddPicture "C:\Users\James\Desktop\Hampshire.bmp"

Can someone please show me how I can fit the image to the cell dimensions without changing the cell in any way?

 

[Macropod]

Simply give the cell a fixed height and width!

For the:
• height, set the exact row height under Table Tools>Layout>Properties>Row>Specify Height>Exactly.
• width, set the preferred column width under Table Tools>Layout>Properties>Columns, and uncheck the 'automatically resize to fit contents' option under Table Tools>Layout>Properties>Table>Options.

You might also want to set the cell margins to 0 all round. It's also a good idea to format the table paragraph with 0 before/after spacing.

 

[sharky12345]

Got it - thanks.....I've done that and it works fine and it deals with pictures that are too big for the cell, but what about when the image is too small to fill the cell, is there a way I can increase it to fill the cell but keeping the aspect ratio?

 

[Macropod]

Got it - thanks.....I've done that and it works fine and it deals with pictures that are too big for the cell, but what about when the image is too small to fill the cell, is there a way I can increase it to fill the cell but keeping the aspect ratio?

For that, you might use code along the lines of:

Sub ResizeTablePics(Tbl As Table)
Dim Tbl As Table, iShp As InlineShape
With Tbl.Range
  For Each iShp In .InlineShapes
    With iShp
      .LockAspectRatio = True
      With .Range.Cells(1).Range.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
      End With
      With .Range.Cells(1)
        .TopPadding = 0
        .BottomPadding = 0
        .LeftPadding = 0
        .RightPadding = 0
        If .HeightRule = wdRowHeightExactly Then
          If .Column.PreferredWidthType = wdPreferredWidthPoints Then
            If .Height <> iShp.Height Then
              If .Width <> iShp.Width Then
                If .Height > iShp.Height Then
                  iShp.Height = .Height
                  If .Width < iShp.Width Then
                    iShp.Width = .Width
                  End If
                End If
              End If
            End If
          End If
        End If
      End With
    End With
  Next
End With
End Sub

The above is probably overkill for what you want; it checks & formats all cells containing inlineshapes in the nominated table, optimising both the paragraph parameters and the cell parameters for the image fitting. Only cells that have a fixed height and width are processed - because there's nothing to 'lock' the image size to otherwise.

 

[sharky12345]

Thanks Paul, very much appreciated - the other thing I've considered is how big the file will be after resizing the image so I've thought about compressing it - I've tried sendkeys but that just gives me a dialog box to manually click, is there a way to avoid that do you know?

 

[Macropod]

Unfortunately, Word 2007 & later provide no programmatic access to Word's image compression tools. That's because Word 2007 & later contain two command bars with the same ID - one being the new one, the other being the older Word 2003 & earlier one - but it’s only the older non-functioning one the SendKeys code activates.

 

[sharky12345]

Ok, thanks Paul - I'm wondering if I can come up with something staying within Excel rather than putting it in a Word document so I'll have a play - thanks for your help.

 

[jessicawhite]

Can it work on word 2017?

 

[Macropod]

Can it work on word 2017?

There is no such product.

 

[sharky12345]

Paul,

I'm struggling to sort the resizing out, I'm getting 'User defined type not defined' when I try to run your resizing suggestion but don't know why?