Insert HeaderFooter using vba

Occasional Contributor

I have been trying to insert header using the given blow code. But at one time it's working and other time it shows the error 6028 (the range cannot be deleted). If anyone have idea how to correct this plz share.


Sub UpdateHeader()

Dim oDoc As Word.Document, oSec As Word.Section, rng As Word.Range
Set oDoc = ActiveDocument

For Each oSec In oDoc.Sections
Set rng = oSec.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterFirstPage).Range
AddHeaderToRange rng

Set rng = oSec.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
AddHeaderToRange rng
Next oSec
End Sub

Private Sub AddHeaderToRange(rng As Word.Range)
With rng
.Tables.Add Range:=rng, NumRows:=1, NumColumns:=2
With .Tables(1)
.Borders.InsideLineStyle = wdLineStyleNone
.Borders.OutsideLineStyle = wdLineStyleNone
.Rows.SetLeftIndent LeftIndent:=-37, RulerStyle:=wdAdjustNone
.Columns(2).SetWidth ColumnWidth:=300, RulerStyle:=wdAdjustNone
.Cell(1, 1).Range.InlineShapes.AddPicture FileName:="Your Picture Location", LinkToFile:=False, SaveWithDocument:=True
.Cell(1, 2).Range.Font.Name = "Arial"
.Cell(1, 2).Range.Font.Size = 9
.Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
.Cell(1, 2).Range.Text = "Test header" & vbNewLine & "Second Line"
End With
End With
End Sub

0 Replies