Sub InsertLogoDialog2()
On Error GoTo errInsert
Dim oDialog As Word.Dialog, lngPictureSize As Double
Set oDialog = Dialogs(wdDialogInsertPicture)
Dim pic As InlineShape
With oDialog
.Display
Application.ScreenUpdating = False
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes("LogoA").Select
Selection.Delete
If .Name <> "" Then
Set pic = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes.AddPicture(FileName:=.Name, _
LinkToFile:=False, _
SaveWithDocument:=True, Range:=Selection.Range)
If pic.Height > pic.Width Then
With pic
pic.LockAspectRatio = msoTrue
If pic.Height > MillimetersToPoints(16.1) Then pic.Height = MillimetersToPoints(16.1)
End With
Else
With pic
pic.LockAspectRatio = msoTrue
If pic.Width > MillimetersToPoints(100) Then pic.Width = MillimetersToPoints(50)
End With
End If
pic.ConvertToShape.Select
With Selection.ShapeRange
.Name = "LogoA"
.WrapFormat.Type = wdWrapTight
.Left = CentimetersToPoints(0.98)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Top = CentimetersToPoints(0.98)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
End With
End If
'error here
ActiveDocument.ActiveWindow.View.SeekView = wdSeekMainDocument
Application.ScreenUpdating = True
End With
Set oDialog = Nothing
Exit Sub
errInsert:
MsgBox Err.Description, , "Error:Insert Picture"
End Sub
|