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

tangqingfu

能否请各位帮解决下面的问题或部分问题？
1、做了一个“密封线”样式的文本框，将其存为自动图文集（该自动图文集保存在normal中），请教如何编写VBA代码，能将该自动图文集插入到在“页眉和页脚”状态下的文档左侧，该文本框距文档页边距左侧为1cm，距页边距上、下位置相等(居中）,并将该文档的左边距修改为3.5cm，右边距修改为1.5cm后，插入后光标恢复到插入前的位置？
如果该自动图文集保存于“C:\Documents and Settings\Administrator\Application Data\Microsoft\Word\STARTUP”下名为“学科工具”模板中，又该如何编写代码？
2、做两个密封线，名称分别为“密封线1”和“密封线2”样式的文本框，将其分别存为自动图文集（两个自动图文集保存在normal中），如何将文档的页面设置修改为“奇偶页不同”、页边距中的上下边距分别设置2.5cm、内侧为3.5cm、外侧为1.5cm，并一次性添加两部分的密封线，奇数页页眉和页脚中插入的密封线为密封线1（密封线1内填有学校，姓名，班级及密封线等），偶数页页眉和页脚中插入的密封线为密封线2（偶数页的密封线内不用填写奇数页要求的内容如学校、班级、姓名等，只要密封线即可），让两部分的密封线与边距分别相等(重合），插入后光标恢复到插入前的位置？
如果两个自动图文集保存于“C:\Documents and Settings\Administrator\Application Data\Microsoft\Word\STARTUP”下名为“学科工具”模板中，又该如何编写代码？

密封线样式如下（附件）：

[ 本帖最后由 tangqingfu 于 2010-8-31 23:53 编辑 ]

守柔

问题2同问题1基本相似。
仅作一个问题1的解决方案示例，供参考，希望楼主能够静心揣摩，以期举一反二。
Sub Example()
    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 = "NORMAL.DOT"    '''需加载"学科工具.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
        Set mySection = ActiveDocument.Sections(1)
        With mySection
            With .PageSetup
                .LeftMargin = Word.CentimetersToPoints(3)
                .RightMargin = Word.CentimetersToPoints(1.5)
                sngHeight = .PageHeight
            End With
            Set myRange = .Headers(wdHeaderFooterPrimary).Range
            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(2)
                .Top = (sngHeight - .Height) * 0.5
            End With
        End With
    End If
End Sub

tangqingfu

谢谢守版的帮助！
测试通过！
代码得好好揣摩，以期举一反二。

tangqingfu

将密封线设置为“奇偶页不同”，请教如何实现将反面密封线插入到偶数页的右侧，设置“对称页边距”的代码该如何写？下面的代码插入的反面密封线（位于偶数页）也在文档的左侧。
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"    '''需加载"学科工具.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
        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
            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
            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 = Word.CentimetersToPoints(0.5)
                .Top = (sngHeight - .Height) * 0.5
            End With
        End With
    End If
End Sub

[ 本帖最后由 tangqingfu 于 2010-9-5 12:32 编辑 ]

tangqingfu

顶一下，希望能得到帮忙……

tangqingfu

奇怪，今天再测试守版的代码，提示
运行时错误‘4605’：
RelativeHorizontalPoisition方法或属性无效因为绘图操作无法应用于当前所选内容
能否请守版再帮帮忙？
请教如何让插入到偶数页的密封线与奇数页的密封线重合？（即一楼的问题），曾数度尝试，还是无法通过VBA代码自行解决。
能否请守版再出手帮助？

[ 本帖最后由 tangqingfu 于 2010-9-8 23:18 编辑 ]

csnAlex

我觉得除了“奇偶页不同”外，还应设置“首页不同”。因为如果卷面有4张纸，则除了首页需要填写之外，第三张也不应该再填写学校、姓名了。

另外，试卷直接做成模板了，还要填写“图文集”不是没有意义了吗？

tangqingfu

谢谢csnAlex兄的关注！
是否要设置“首页不同”，因人而异。
原来我觉得试卷直接做成模板就可以了，但是发现该模板只对由该模板生成的文档有效，对于其他纸型的文档，如果要快速设置其（正反两面）密封线，就麻烦了，除了要修改其页面设置外，还要将密封线复制到该文档，一旦正反两面都要设置密封线，还很难做到正反两面的密封线能吻合。所以希望借助“自动图文集”的词条和VBA代码的方式，能快速对各种纸型的文档自动添加（正反两面）密封线，使其更有通用性。
能否请csnAlex兄帮忙？

szqhb

tang兄以前给的密封线的模板已经很好了

csnAlex

新修改的在 http://club.excelhome.net/thread-624038-1-1.html