VBA 在 header 中插入 table
VBA insert table in header
我想使用 vba 在 header 中插入 2 列和一行。我尝试了以下代码,但它一次有效,另一次给出错误 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
尝试:
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
我想使用 vba 在 header 中插入 2 列和一行。我尝试了以下代码,但它一次有效,另一次给出错误 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
尝试:
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