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