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