PDA

View Full Version : Macro for resize and crop picture with different size of table cells in word



FaizanRoshan
10-17-2015, 11:01 AM
I have macro code that take picture form folder and insert it in word table cell, and then crop it.
Now i have many table cells in Ms Word with different size. i want to make some change in code so that it resize and crop pictures auto with the size of table cells. Table cells never change its size.
Here is 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
If .Height > .Range.Cells(1).Height Then
.Height = .Range.Cells(1).Height
End If
If .Width > .Range.Cells(1).Width Then
.Width = .Range.Cells(1).Width
End If
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

CPR
11-26-2015, 11:48 AM
In the above code is a syntax error!
Does anybody has a solution?
Thx

gmaxey
11-26-2015, 05:16 PM
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
If .Height > .Range.Cells(1).Height Then
.Height = .Range.Cells(1).Height
End If
If .Width > .Range.Cells(1).Width Then
.Width = .Range.Cells(1).Width
End If
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