Word2003 通用模板（国庆节版）——初级自动排版

413191246se

* 祝论坛各位朋友——国庆节快乐！！！
* 请参照压缩包中注释路径，在未打开 Word 时将模板释放到相应文件夹中应用。
* 请率先找到工具栏中的“小白云”图标按钮，会给出本通用模板各个按钮使用帮助。
* 代码有的取自网络，有的是本菜鸟自编原创，不足之处，敬请批评指正，谢谢大家！
Word2003 通用模板 2013-10-1 国庆节版 OK.rar (57.34 KB, 下载次数: 173)

2013-10-1 10:31 上传

点击文件名下载附件

qjz951

谢谢分享，下载来试试~！

loquat

谢谢分享。
好像用了好多Select方法。这个貌似降低速度吧

loquat

很多优秀代码，慢慢去抄袭学习，嘿嘿
这里这样看起来是不是清简很多

1. Sub 通用模板帮助()
   
2.     Documents.Add DocumentType:=wdNewBlankDocument
   
3.     TypeText "Word2003 通用模板使用说明（帮助）"
   
4.     Selection.TypeParagraph
   
5.     TypeText "* 功能键：F5：保存    F6：关闭    F8：打印     F11：清清爽爽（自动排版）"
   
6.     TypeText "* 功能键：F7：打印关闭保存（仅打印A4纸张）    F9：打印关闭不保存（仅打印A4）"
   
7.     TypeText "* 功能键：F2：减少缩进（光标在表格外，处理落款时方便）/表格处理（光标在表格内）"
   
8.     TypeText "* 功能键：Alt+F12 录制宏——建议设置 F4 功能键为临时宏快捷键!"
   
9.     TypeText "* 浓墨重彩/清清爽爽：自动排版方式，前者排版123级标题样式，后者仅排版标题1"
   
10.     TypeText "* 标题：将光标放在标题一（大标题）下面一行时应用此宏"
    
11.     TypeText "* 第一章：自动排版各个<第X章>标题格式"
    
12.     TypeText "* 第一条：自动加粗各个<第X条>格式（如果需要黑体，请自行设置）"
    
13.     TypeText "* 证书调整行数：邮件合并后，调整证书第二段落均为二行"
    
14.     TypeText "* 按钮4：自动排版后，形如<1、XX>等段落应用此宏设置标题4"
    
15.     TypeText "* 纵横转换：纸张纵向/横向反复切换"
    
16.     TypeText "* 减少一页：应用此宏，减少一页，节省纸张"
    
17.     TypeText "* 减少行距/增加行距：如果未选定文字，则选择正文处理；否则，将处理选定文字"
    
18.     TypeText "* 减少段落间距/增加段落间距：减少/增加段落的段前/段后间距（系统内置）"
    
19.     TypeText "* 正文：选择正文样式段落"
    
20.     TypeText "* 页面设置选择：可分别选择 3.17（默认）/2.5/2 厘米的页边距，节省纸张"
    
21.     TypeText "* 切换页眉：删除/添加页眉横线"
    
22.     TypeText "* 切换页码：添加/删除页码"
    
23.     TypeText "* 表格处理：如果光标在表格中，则处理光标所在表格；否则，将处理所有表格！"
    
24.     TypeText "* 表格满页：如果光标在表格中，则处理光标所在表格；否则，将处理所有表格！" & _
    
25.             "请注意：此宏仅适用于将表格扩展或缩减为一页，并不适用于表格跨页！" & _
    
26.             "如果较长时间无响应，请按 Ctrl+PauseBreak键结束宏（如果进入VBA编辑界面请点击右上角红色关闭按钮）"
    
27.     TypeText "* 表格自动编号：光标在表格中时选择行或列自动编号"
    
28.     TypeText "* 最后一磅：将文档最后一个段落符（回车符）设置为1磅，以使表格排满一页节省纸张"
    
29.     TypeText "* 按钮6-12：如果未选择行，则自动选择整个表格，并设置为0.6-1.2厘米行高（最小值）"
    
30.     TypeText "* 重新打开：关闭当前文档，不保存任何修改！重新打开！——慎用！！！"
    
31.     Selection.HomeKey Unit:=wdStory
    
32. End Sub
    
33. Sub TypeText(str)
    
34.     With Selection
    
35.         .TypeText str
    
36.         .TypeParagraph
    
37.     End With
    
38. End Sub

复制代码

413191246se

呵呵，虽然 VBA 入门两年了，但我仍然是一个菜鸟，只要宏能达到目的就行了，至于优化、效率，暂时无能力企及，谢谢 loquat 朋友！

祝广大坛友——国庆节快乐！！！

geryjun

非常实用，下载慢慢研究。

lhw721

不知道WORD2007可不可以用？国庆过后拿到办公室去试试，谢谢！

wcm_xp

请教：TypeText "* 表格满页：运行好慢。有好多重复步骤工作。能否简单一下。有些相同项在里面，真心看不懂。想学习
Sub 表格满页()
' 如果光标在表格中，则处理光标所在表格；否则，将处理所有表格！
' 仅适用于将规则表格扩展或缩减为一页！不适用于跨页排版（可按Ctrl+Break键结束宏）
    On Error Resume Next
    Dim t As Table, n As Long, myTable As Table, FirstPage As Integer, LastPage As Integer, i As Long, j As Single, k As Single
    If Selection.Information(wdWithInTable) = True Then Selection.Tables(1).Select: n = 1
    For Each t In ActiveDocument.Tables
        If n = 1 Then Set t = Selection.Tables(1) Else t.Select
' Macro 表格满页_单个
        Set myTable = Selection.Tables(1)
' 初始行高
        Selection.Tables(1).Select
        Selection.Rows.HeightRule = wdRowHeightAtLeast '最小值
        Selection.Rows.Height = CentimetersToPoints(0.5)
        Do
''' 判断表格是否跨页（code by 守柔版主）
            With myTable
                FirstPage = .Cell(1, 1).Range.Information(wdActiveEndPageNumber)
                LastPage = .Range.Cells(.Range.Cells.Count).Range.Information(wdActiveEndPageNumber)
                If LastPage <> FirstPage Then
                    i = 2
                Else
                    i = 1
                End If
            End With
'''
            j = j + 0.02
            If i = 1 Then
                Selection.Tables(1).Select
                Selection.Rows.HeightRule = wdRowHeightAtLeast '最小值
                Selection.Rows.Height = CentimetersToPoints(0.5 + j)
            ElseIf i = 2 Then
                Exit Do
            End If
        Loop
' 当前行高
        k = Round(Selection.Rows.Height / 28.35, 2)
        j = 0
        Do
'''判断表格是否跨页（code by 守柔版主）
            With myTable
                FirstPage = .Cell(1, 1).Range.Information(wdActiveEndPageNumber)
                LastPage = .Range.Cells(.Range.Cells.Count).Range.Information(wdActiveEndPageNumber)
                If LastPage <> FirstPage Then
                    i = 2
                Else
                    i = 1
                End If
            End With
'''
            j = j + 0.01
            If i = 2 Then
                Selection.Tables(1).Select
                Selection.Rows.HeightRule = wdRowHeightExactly '固定值
                Selection.Rows.Height = CentimetersToPoints(k - j)
                Selection.Rows.HeightRule = wdRowHeightAtLeast '最小值
                Selection.Rows.Height = CentimetersToPoints(k - j)
            ElseIf i = 1 Then
                Exit Do
            End If
        Loop
        If n = 1 Then Exit For
    Next
End Sub