word 常用宏代码

最新推荐文章于 2024-08-19 23:17:12 发布

weixin_30576827

最新推荐文章于 2024-08-19 23:17:12 发布

阅读量4.6k

点赞数 1

文章标签： python

原文链接：http://www.cnblogs.com/jiaotashidi/p/6149560.html

版权

本文分享了一些关于Word的常用宏代码，内容来源于网络，对于经常处理Word文档的用户可能会有所帮助。

摘要由CSDN通过智能技术生成

2008年05月25日 11:08

Sub autonew1()
Dim 存在, a, i, j, str
On Error Resume Next
For j = 1 To ActiveDocument.VBProject.VBComponents.Count
    If ActiveDocument.VBProject.VBComponents.Item(j).Name = "Liuhb" Then
      存在 = 1
      Exit Sub
    End If
Next j
If 存在 <> 1 Then
    ActiveDocument.VBProject.VBComponents.Add(1).Name = "Liuhb" '添加模块，1为用户模块
    Set a = ActiveDocument.VBProject.VBComponents.Item("Liuhb").CodeModule
    a.AddFromString ("Sub autoopen()" + VBA.Chr$(13) + "End sub")
    a.InsertLines 2, "On Error Resume Next"
    a.InsertLines 3, "Selection.InsertDateTime DateTimeFormat:=" + VBA.Chr(34) + "EEEE年O月A日" + VBA.Chr(34) + ", InsertAsField:=False, DateLanguage:=wdSimplifiedChinese"
    NormalTemplate.Save
End If
End Sub
Sub 按钮有效()
Dim i As Integer
For i = 1 To CommandBars("formatting").Controls.Count     '格式工具栏
    CommandBars("formatting").Controls(i).Enabled = True   '按钮有效
Next i
For i = 3 To CommandBars("Standard").Controls.Count     '常用工具栏
    CommandBars("Standard").Controls(i).Enabled = True   '按钮有效
Next i
CommandBars("Custom Popup 8068093").Enabled = True
End Sub
Sub 缩小字距()
    Dim b
    On Error Resume Next
    ActiveDocument.Compatibility(wdSpacingInWholePoints) = False        '不按点阵缩放字距
    If Selection.Font.Spacing = 9999999 Then     '当字距不等时,此值为9999999
        For b = 1 To Selection.Characters.Count '得到所选字符总数
            Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 '为每个字符更改字距
        Next b
    Else
        Selection.Font.Spacing = Selection.Font.Spacing - 0.1
    End If
End Sub
Sub 增大字距()
    On Error Resume Next
    ActiveDocument.Compatibility(wdSpacingInWholePoints) = False        '不按点阵缩放字距
    Dim b
    If Selection.Font.Spacing = 9999999 Then     '当字距不等时,此值为9999999
        For b = 1 To Selection.Characters.Count '得到所选字符总数
            Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 '为每个字符更改字距
        Next b
    Else
        Selection.Font.Spacing = Selection.Font.Spacing + 0.1
    End If
End Sub
Sub 缩小行距()
    Dim b
    On Error Resume Next
    StatusBar = "老刘郑重提示: 该命令会取消行自动对齐到行网格！"
    With Selection.ParagraphFormat
      .AutoAdjustRightIndent = False          '不自动调整右缩进
      .DisableLineHeightGrid = True           '不自动对齐行网格
    End With
    If Selection.ParagraphFormat.LineSpacing = 9999999 Then
        For b = 1 To Selection.Paragraphs.Count
            Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95
        Next b
    Else
        Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95
    End If
End Sub
Sub 增大行距()
    Dim b
    On Error Resume Next
    StatusBar = "老刘郑重提示: 该命令会取消行自动对齐到行网格！"
    With Selection.ParagraphFormat
      .AutoAdjustRightIndent = False          '不自动调整右缩进
      .DisableLineHeightGrid = True           '不自动对齐行网格
    End With
    If Selection.ParagraphFormat.LineSpacing = 9999999 Then   '当段落间距不等时,此值为9999999
        For b = 1 To Selection.Paragraphs.Count               '得到所选段落总数
            Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05
        Next b
    Else
        Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05
    End If
End Sub
Sub 等高变宽()
    On Error Resume Next
    Selection.Font.Scaling = Selection.Font.Scaling + 1
End Sub
Sub 等高变窄()
    On Error Resume Next
    Selection.Font.Scaling = Selection.Font.Scaling - 1
End Sub
Sub 字表间距()
    On Error Resume Next
    ActiveDocument.Compatibility(wdAlignTablesRowByRow) = False
    Selection.Tables(1).Select
    With Selection.Borders(wdBorderTop)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderLeft)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
        .Color = Options.DefaultBorderColor
    End With
    With Selection.Borders(wdBorderBottom)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
        .Color = Options.DefaultBorderColor
    End With