请教如何通过VBA代码将指定自动图文集插入到文档的页眉处?

tangqingfu

感谢csnAlex兄写的代码：
Sub 双面密封线()
Dim aTemp As Template
    Dim mySection As Section
    Dim myRange As Range
    Dim myShape As Shape
    Dim sngHeight As Single
    Dim blnTempExitsts As Boolean
    Dim strTempName As String
    strTempName = "学科工具.DOT"    '''需加载"normal.dot",此处请自行修改为"学科工具模板.DOT"
    '''并确保其具有一个含有文本框(图形)的"密封线"自动图文集,此处不作判断了
    For Each aTemp In Templates
        If UCase$(aTemp.Name) = strTempName Then
            blnTempExitsts = True
            Exit For
        End If
    Next aTemp
    If blnTempExitsts = True Then
        '判断高度
        If ActiveDocument.PageSetup.PageHeight < 700 Then
            MsgBox "页面高度小于24.7厘米，不能插入密封线！", vbOKOnly + vbInformation, "试卷设置工具"
            Exit Sub
        End If
   
        '页面设置

            With ActiveDocument.PageSetup
                .OddAndEvenPagesHeaderFooter = True
                .DifferentFirstPageHeaderFooter = False
                .MirrorMargins = True
            End With
        End If
        
        '插入密封线
        Set mySection = ActiveDocument.Sections(1)
        With mySection
            With .PageSetup
                .OddAndEvenPagesHeaderFooter = True
                .LeftMargin = Word.CentimetersToPoints(3.5)
                .RightMargin = Word.CentimetersToPoints(1.5)
                sngHeight = .PageHeight
            End With
            Set myRange = .Headers(wdHeaderFooterPrimary).Range
            '取消页眉的横线
            With myRange
                .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            End With
            myRange.Collapse wdCollapseStart
            aTemp.AutoTextEntries("正面密封线").Insert Where:=myRange, RichText:=True
            Set myRange = .Headers(wdHeaderFooterPrimary).Range
            Set myShape = myRange.ShapeRange(1)
            With myShape
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .RelativeVerticalPosition = wdRelativeVerticalPositionPage
                .Left = Word.CentimetersToPoints(0.5)
                .Top = (sngHeight - .Height) * 0.5
            End With
        End With
        With mySection
            With .PageSetup
                .OddAndEvenPagesHeaderFooter = True
                .LeftMargin = Word.CentimetersToPoints(3.5)
                .RightMargin = Word.CentimetersToPoints(1.5)
                sngHeight = .PageHeight
            End With
            Set myRange = .Headers(wdHeaderFooterEvenPages).Range
            '取消页眉的横线
            With myRange
                .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            End With
            myRange.Collapse wdCollapseStart
            aTemp.AutoTextEntries("反面密封线").Insert Where:=myRange, RichText:=True
            Set myRange = .Headers(wdHeaderFooterEvenPages).Range
            Set myShape = myRange.ShapeRange(1)
            With myShape
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .RelativeVerticalPosition = wdRelativeVerticalPositionPage
                .Left = mySection.PageSetup.PageWidth - Word.CentimetersToPoints(2.5) - .Width
                .Top = (sngHeight - .Height) * 0.5
            End With
        End With
End Sub