Try the following:
Code:
Sub EditHeaderTextBox()
Dim Shp As Shape, Doc As Document, strText As String
Dim i As Long, docToOpen As FileDialog, sHght As Single
On Error GoTo Err_Exit
strText = InputBox("New Text", "Header Textbox Update", "New Text")
' Switch off the updates of screen
Application.ScreenUpdating = False
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
docToOpen.Show
For i = 1 To docToOpen.SelectedItems.Count
'Open each document
Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
With Doc
With .Sections(1)
For Each Shp In .Headers(wdHeaderFooterPrimary).Shapes
With Shp
If .Type = msoTextBox And .Name = "Text Box 1" Then
With .TextFrame
.AutoSize = True
.MarginLeft = 0
With .TextRange
With .Font
.Name = "Arial"
.Size = 10
End With
.Text = strText
End With
End With
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
sHght = .Top + .Height
Else
sHght = 0
End If
End With
If sHght <> 0 Then .PageSetup.TopMargin = sHght
Next
End With
.Close SaveChanges:=wdSaveChanges
End With
Next
Set docToOpen = Nothing: Set Doc = Nothing
' Switch Screen updates back on
Application.ScreenUpdating = True
Exit Sub
Err_Exit:
MsgBox Err.Description & Err.Number
End Sub
Another problem you'll most likely have is that you have not only a textbox but also a horizontal line and the latter doesn't move when the header is resized. You could obviate that problem by:
1. deleting the blue line;
2. changing the textbox wrapping to 'inline'; and
3. formatting the paragraph containing the textbox as right-aligned with a blue bottom border and left/right margins of -2.5 cm.
You could then use:
Code:
Sub EditHeaderTextBox()
Dim Shp As Shape, Doc As Document, strText As String
Dim i As Long, docToOpen As FileDialog
On Error GoTo Err_Exit
strText = InputBox("New Text", "Header Textbox Update", "New Text")
' Switch off the updates of screen
Application.ScreenUpdating = False
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
docToOpen.Show
For i = 1 To docToOpen.SelectedItems.Count
'Open each document
Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
With Doc
With .Sections(1)
For Each Shp In .Headers(wdHeaderFooterPrimary).Shapes
With Shp
If .Name = "Text Box 1" Then
With .TextFrame
.AutoSize = True
.MarginLeft = 0
With .TextRange
With .Font
.Name = "Arial"
.Size = 10
End With
.Text = strText
End With
End With
End If
End With
Next
End With
.Close SaveChanges:=wdSaveChanges
End With
Next
Set docToOpen = Nothing: Set Doc = Nothing
' Switch Screen updates back on
Application.ScreenUpdating = True
Exit Sub
Err_Exit:
MsgBox Err.Description & Err.Number
End Sub
Even so, unless you plan to have the header content on every page, I'd be inclined to use a 'different first page setup' and put the header content in the first page header, with the attendant code change of:
wdHeaderFooterPrimary
to:
wdHeaderFooterFirstPage
That way, your other pages will also not require as much space for the header if it expands beyond whatever your default page margins are on the first page.