MicrosoftWord2010下的VBA宏：生成标题提纲

编写本脚本的Office版本：Microsoft Office 2010

本段脚本，可以用来生成一个需求分析文档的提纲：

在上方的“视图→宏（最右边）→查看宏”中，创建一个宏，添加如下代码：

‘宏名称：DemandAnalysis
‘宏功能：生成需求分析模版
Sub DemandAnalysis()

    ‘设置标题自动编号
    SetNumber
    
    WriteTitle "需求分析文档"
    
    ‘文档适用范围
    WriteHeadline "文档适用范围", 1
    WriteWord "在这里输入正文"
    
    ‘总体要求
    WriteHeadline "总体要求", 1
    WriteWord "在这里输入正文"
    WriteHeadline "总体功能要求", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件开发平台要求", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件项目的开发实施过程管理要求", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件项目实施过程总体要求", 3
    WriteWord "在这里输入正文"
    WriteHeadline "软件项目实施变更要求", 3
    WriteWord "在这里输入正文"
    WriteHeadline "软件项目实施里程碑控制", 3
    WriteWord "在这里输入正文"
    
    ‘软件开发
    WriteHeadline "软件开发", 1
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的需求分析", 2
    WriteWord "在这里输入正文"
    WriteHeadline "需求分析", 3
    WriteWord "在这里输入正文"
    WriteHeadline "需求分析报告的编制者", 3
    WriteWord "在这里输入正文"
    WriteHeadline "需求报告评审", 3
    WriteWord "在这里输入正文"
    WriteHeadline "需求报告格式", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的概要设计", 2
    WriteWord "在这里输入正文"
    WriteHeadline "概要设计", 3
    WriteWord "在这里输入正文"
    WriteHeadline "编写概要设计的要求", 3
    WriteWord "在这里输入正文"
    WriteHeadline "概要设计报告的编制者", 3
    WriteWord "在这里输入正文"
    WriteHeadline "概要设计和需求分析、详细设计之间的关系和区别", 3
    WriteWord "在这里输入正文"
    WriteHeadline "概要设计的评审", 3
    WriteWord "在这里输入正文"
    WriteHeadline "概要设计格式", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的详细设计", 2
    WriteWord "在这里输入正文"
    WriteHeadline "详细设计", 3
    WriteWord "在这里输入正文"
    WriteHeadline "特例", 3
    WriteWord "在这里输入正文"
    WriteHeadline "详细设计的要求", 3
    WriteWord "在这里输入正文"
    WriteHeadline "数据库设计", 3
    WriteWord "在这里输入正文"
    WriteHeadline "详细设计的评审", 3
    WriteWord "在这里输入正文"
    WriteHeadline "详细设计格式", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的编码", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件编码", 3
    WriteWord "在这里输入正文"
    WriteHeadline "软件编码的要求", 3
    WriteWord "在这里输入正文"
    WriteHeadline "编码的评审", 3
    WriteWord "在这里输入正文"
    WriteHeadline "编程规范及要求", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的测试", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件测试", 3
    WriteWord "在这里输入正文"
    WriteHeadline "测试计划", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的交付准备", 2
    WriteWord "在这里输入正文"
    WriteHeadline "交付清单", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "软件的鉴定验收", 2
    WriteWord "在这里输入正文"
    WriteHeadline "软件的鉴定验收", 3
    WriteWord "在这里输入正文"
    WriteHeadline "验收人员", 3
    WriteWord "在这里输入正文"
    WriteHeadline "验收具体内容", 3
    WriteWord "在这里输入正文"
    WriteHeadline "软件验收测试大纲", 3
    WriteWord "在这里输入正文"
    
    WriteHeadline "培训", 2
    WriteWord "在这里输入正文"
    WriteHeadline "系统应用培训", 3
    WriteWord "在这里输入正文"
    WriteHeadline "系统管理的培训", 3
    WriteWord "在这里输入正文"
    
    ‘附录
    ‘WriteHeadline "附录A", 1
    ‘WriteWord "在这里输入正文"
    
End Sub

‘例程：设置标题自动编号
Sub SetNumber()

    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(0.76)
        .TabPosition = wdUndefined
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 1"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)
        .NumberFormat = "%1.%2"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(1.02)
        .TabPosition = wdUndefined
        .ResetOnHigher = 1
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 2"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(3)
        .NumberFormat = "%1.%2.%3"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(1.27)
        .TabPosition = wdUndefined
        .ResetOnHigher = 2
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 3"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(4)
        .NumberFormat = "%1.%2.%3.%4"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(1.52)
        .TabPosition = wdUndefined
        .ResetOnHigher = 3
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 4"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(5)
        .NumberFormat = "%1.%2.%3.%4.%5"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(1.78)
        .TabPosition = wdUndefined
        .ResetOnHigher = 4
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 5"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(6)
        .NumberFormat = "%1.%2.%3.%4.%5.%6"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(2.03)
        .TabPosition = wdUndefined
        .ResetOnHigher = 5
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 6"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(7)
        .NumberFormat = "%1.%2.%3.%4.%5.%6.%7"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(2.29)
        .TabPosition = wdUndefined
        .ResetOnHigher = 6
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 7"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(8)
        .NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(2.54)
        .TabPosition = wdUndefined
        .ResetOnHigher = 7
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 8"
    End With
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(9)
        .NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8.%9"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(2.79)
        .TabPosition = wdUndefined
        .ResetOnHigher = 8
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = "标题 9"
    End With
        
End Sub

‘例程：书写文章大标题
Sub WriteTitle(Word As String)

    Selection.Font.Name = "黑体"
    Selection.Font.Size = 24
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeText Text:=Word
    Selection.TypeParagraph

End Sub

‘例程：书写“标题 1”-“标题 6”
Sub WriteHeadline(Word As String, Level As Integer)


    Selection.Style = ActiveDocument.Styles("标题 " & Level)
    ActiveWindow.DocumentMap = True
    Selection.TypeText Text:=Word
    Selection.TypeParagraph

End Sub

‘例程：书写正文
Sub WriteWord(Word As String)

    Selection.Font.Name = "宋体"
    Selection.Font.Size = 10.5
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.TypeText Text:="    " & Word ‘自然段前要加空格
    Selection.TypeParagraph
    
End Sub

‘例程：清空全部文字（测试例程）
Sub Clean()
    
    Selection.WholeStory
    Selection.TypeBackspace
    
End Sub

运行后就可以生成一个自动编号标题的需求分析文档了

如果要把这段代码用于生成其他的文档标题提纲，只需要在例程（Sub）DemandAnalysis()中，调用如下的函数：

1）SetNumber：调用SetNumber例程，为标题自动编号。这个例程在开始调用且仅调用一次

2）WriteTitle：例程，用于撰写居中的标题，在该例程中可以设置标题的字体等样式

3）WriteHeadline：例程，撰写标题，第一个参数为标题的文字，第二个参数是一个数字，代表了标题的级别（1级标题字体最大）

4）WriteWord：例程，撰写正文

END

MicrosoftWord2010下的VBA宏：生成标题提纲

原文：http://my.oschina.net/Tsybius2014/blog/331950