Solved: Auto Fit Picture In Table and do not change column specified height

[r_know]

Dear All,

I have inserted the a lot picture in Table Rows. I want they AUTO fit to column width by one macro code or word 2010 tricks.

Please advise perfect solution.

Regards,

RAhuL>
:beerchug:

[fumei]

Have you tried recording a macro? What have you tried? Anything?

[r_know]

Hi,

I am not aware , how run macro in Word 2010.

I try, but do not move cursor.

Also, I search on google and having very limited info about VBA WORD 2010.

Please answer if you can to solve the thread.

Regards,
Rahul

[macropod]

Hi Rahul,

There is a vast amount of information about Word vba on the web, the great majority of which is applicable to Word 2010.

When you put a picture into a table cell via Insert|picture, Word's default behaviour is to autofit the pictures to the cell size. However, if you don't fix the cell's height and turn off the 'automatically resize to fit contents' option, the table cell will expand - because that's what it's meant to do.

But, if you insert a picture into the document, then drag it into the table cell, the picture doesn't resize.

So it seems to me your problem is caused by you not doing things the right way in the first place.

Here's a macro that should help fix things. Note that, if you have cell border padding or before/after spacing in the cell paragraph, neither of those are taken into account.
Sub Demo()
Dim iShp As InlineShape
With ActiveDocument
For Each iShp In InlineShapes
If iShp.Range.Information(wdWithInTable) = True Then
With iShp
.LockAspectRatio = True
.Width = .Range.Cells(1).Column.PreferredWidth
If .Range.Cells(1).HeightRule > 0 Then
If .Height > .Range.Cells(1).Height Then
.Height = .Range.Cells(1).Height
End If
End If
End With
End If
Next
End With
End Sub

[r_know]

Dear Paul,

Pls see the snap shot. After Run the code.

It seems picture shrink to left corner.

I have two column in table.

Regards,

RL

[macropod]

The most likely explanation is that your row heights haven't been set large enough for the pictures on those rows. They're evidently set to a fairly small 'at least' value. Try deleting the lines:
If .Range.Cells(1).HeightRule > 0 Then
If .Height > .Range.Cells(1).Height Then
.Height = .Range.Cells(1).Height
End If
End If

[r_know]

Dear Paul,

No still same problem after deleting lines.

Pls help as I have to submit this contract comments today; if i go one by one to picture to auto fit column width then a time wasting.

Regards,

RahuL>

[macropod]

In that case, there seems to be something else in the table that's forcing the column width to be wider than what you have shown on screen. Unless you attach a copy of an actual document containing the problem table, it would be difficult to diagnose.

[r_know]

It work after some modifications.

THANKS A LOT Mr. PAUL


Sub Demo()
Dim iShp As InlineShape
With ActiveDocument
For Each iShp In InlineShapes
If iShp.Range.Information(wdWithInTable) = True Then
With iShp
.LockAspectRatio = True
.Width = .Range.Cells(1).Column.Width

End With
End If
Next
End With
End Sub