Sub InsertPic()
Dim strFile As String, iShp As InlineShape, Shp As Shape, Rng As Range
On Error Resume Next
With Dialogs(wdDialogInsertPicture)
  .Display
  If .Name <> "" Then
    strFile = .Name
  Else
    Exit Sub
  End If
End With
Set Rng = Selection.Range: Rng.Collapse wdCollapseEnd
Set iShp = ActiveDocument.InlineShapes.AddPicture(strFile, False, True, Rng)
Set Shp = iShp.ConvertToShape
With Shp
  .LockAnchor = True
  .LockAspectRatio = msoTrue
  .Height = .Height / 2
  .RelativeVerticalPosition = wdRelativeVerticalPositionLine
  .Top = 0
  .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
  .Left = wdShapeCenter
End With
Set Rng = Nothing: Set iShp = Nothing: Set Shp = Nothing
End Sub