VBA 在 header 中插入表

Question

I want to insert 2 column and one row in header using vba. I tried the following code but it works one time and gives the error 6028 (the range cannot be deleted) other time. Can any one suggest me any solution.

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 Pic Solution", 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

Answer 1

Try:

Sub UpdateHeaders()
Application.ScreenUpdating = False
Dim Tbl As Table, Sctn As Section
With ActiveDocument
  Set Tbl = .Tables.Add(Range:=.Range(0, 0), NumRows:=1, NumColumns:=2)
  With Tbl
    .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 Pic Solution", 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" & vbCr & "Second Line"
  End With
  For Each Sctn In .Sections
    With Sctn
      With .Headers(wdHeaderFooterPrimary)
        If .LinkToPrevious = False Then .Range.FormattedText = Tbl.Range.FormattedText
      End With
      With .Headers(wdHeaderFooterFirstPage)
        If .LinkToPrevious = False Then .Range.FormattedText = Tbl.Range.FormattedText
      End With
    End With
  Next
  Tbl.Delete
End With
Application.ScreenUpdating = True
End Sub