Question : Work within the header dynamically whilst working with shapes in the header

Hi experts

I'm wondering how I can improve my code below. I need to pick up an existing named shape in the header of my document, delete it, insert a new image and resize and position this.

My code below does this, but when the code is finished I end up still in header of the document. I tried adding ActiveDocument.ActiveWindow.View.SeekView = wdSeekMainDocument to get out of the header but it errors.

How can I rewrite the code below so I don't enter the header physically with my code, ie I work in the header dynamically.

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:

           
           
          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

           
         

Answer : Work within the header dynamically whilst working with shapes in the header

You can work with Shape objects directly. There is no need to select and then Use the Selection.

Also, you can add a Shape. You don't have to add a inline shape and then convert it.

To help me to read the code more easily, I have removed a lot of the vertical spacing and standardised the indenting.

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

           
           
             Sub InsertLogoDialog2()
Dim oDialog As Word.Dialog, lngPictureSize As Double
Dim pic As Shape
Dim rng As Range

On Error GoTo errInsert
Set oDialog = Dialogs(wdDialogInsertPicture)

If oDialog.Display = -1 Then 'Cancel not pressed
    Application.ScreenUpdating = False
    Set pic = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes("LogoA")
    Set rng = pic.Anchor
    pic.Delete
    
    Set pic = ActiveDocument.Shapes.AddPicture(FileName:=oDialog.Name, _
          LinkToFile:=False, _
          SaveWithDocument:=True, Anchor:=rng)
    
    With pic
        .LockAspectRatio = msoTrue
        If .Height > .Width Then
            If .Height > MillimetersToPoints(16.1) Then
                .Height = MillimetersToPoints(16.1)
            End If
        Else
            If .Width > MillimetersToPoints(100) Then
                .Width = MillimetersToPoints(50)
            End If
        End If
        .Name = "LogoA"
        .WrapFormat.Type = wdWrapTight
        .Left = CentimetersToPoints(0.98)
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .Top = CentimetersToPoints(0.98)
        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    End With

End If

'error here (line no longer necessary)
'ActiveDocument.ActiveWindow.View.SeekView = wdSeekMainDocument
Application.ScreenUpdating = True

Set oDialog = Nothing
Exit Sub
errInsert:
 MsgBox Err.Description, , "Error:Insert Picture"
End Sub
           
         