Quote:
Originally Posted by Welshgasman
am thinking slightly differently now, in that I could delete all the existing text in the text box and add afresh?
Would still need to adjust the header depth for any increase in depth of the textbox.
|
You could do that with code like:
Code:
Sub EditHeaderTextBox()
Dim sh 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))
For Each sh In Doc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
If sh.Type = msoTextBox And sh.Name = "Text Box 1" Then
sh.TextFrame.TextRange.Text = strText
sh.TextFrame.AutoSize = True
End If
Next sh
Doc.Save
Doc.Close
Next i
' Switch SCreen updates back on
Application.ScreenUpdating = True
Set docToOpen = Nothing
Set Doc = Nothing
Exit Sub
Err_Exit:
MsgBox Err.Description & Err.Number
End Sub
though you'll have trouble inputting paragraphs breaks, etc. into an InputBox. For anything more complex than a simple text string, you'd probably do better to use and select a formatted string in the document you're running the code from, with code like:
Code:
Sub EditHeaderTextBox()
Dim sh As Shape, Doc As Document, Rng As Range
Dim i As Long, docToOpen As FileDialog
On Error GoTo Err_Exit
' Switch off the updates of screen
Application.ScreenUpdating = False
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
docToOpen.Show
Set Rng = Selection.Range
For i = 1 To docToOpen.SelectedItems.Count
'Open each document
Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
For Each sh In Doc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
If sh.Type = msoTextBox And sh.Name = "Text Box 1" Then
sh.TextFrame.TextRange.FormattedText = Rng.FormattedText
sh.TextFrame.AutoSize = True
End If
Next sh
Doc.Save
Doc.Close
Next i
' Switch SCreen updates back on
Application.ScreenUpdating = True
Set docToOpen = Nothing
Set Rng = Nothing
Set Doc = Nothing
Exit Sub
Err_Exit:
MsgBox Err.Description & Err.Number
End Sub