Mar 31 2021
01:56 AM
- last edited on
Feb 01 2023
02:12 PM
by
TechCommunityAP
Mar 31 2021
01:56 AM
- last edited on
Feb 01 2023
02:12 PM
by
TechCommunityAP
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