VBA 在 header 中插入表

Question

我想使用 vba 在 header 中插入 2 列和 1 行。 我嘗試了以下代碼，但它可以工作一次，並在其他時間給出錯誤 6028（無法刪除范圍）。 任何人都可以建議我任何解決方案。

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

嘗試：

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