一些常用的WORD-VBA代码
- 格式：docx
- 大小：16.32 KB
- 文档页数：6
这里给大家提供一些比较常用的 WORD VB代码，可以提高大家的办公效率，如果不知
道怎么使用这些代码，请自行上网查询 WORD口何运行VBA
1、删除空行
Sub 删除空行 ()
Dim I As Paragraph, n As Integer
Application.ScreenUpdating = False
For Each I In ActiveDocument.Paragraphs
If Len(Trim(I.Range)) = 1 Then
1. Range.Delete
n = n + 1
End If
Next
MsgBox " 共删除空白段落 " & n & " 个"
Application.ScreenUpdating = True
End Sub
2、 奇偶页打印
Sub 奇偶页打印 ()
Dim x, j, i As Integer
On Error Resume Next
x = ExecuteExcel4Macro("Get.Document(50)")
For i = 1 To Int(x / 2) + 1
ActiveWindow.SelectedSheets.PrintOut From:=2 * i - 1, To:=2 * i - 1
Next i
If x = 1 Then
MsgBox " 无偶数页 "
Else
MsgBox " 请将打印出的纸张反向装入纸槽中 ", vbOKOnly, "
For j = 1 To Int(x / 2) + 1
ActiveWindow.SelectedSheets.PrintOut From:=2 * j, To:=2 * j Next j
End If
End Sub打印另一面 "
3、中英文标点互换
Sub 中英文标点互换 ()
Dim ChineseInterpunction() As Variant, EnglishInterpunction() As Variant
Dim myArray1() As Variant, myArray2() As Variant, strFind As String, strRep As String
Dim msgResult As VbMsgBoxResult, N As Byte
'定义一个中文标点的数组对象
", ")", "《", "》")
'定义一个英文标点的数组对象
'注意这里的英文 ,转换为了中文、 ，如果希望将 ,转换为中文，请自行修改！ ' 提示用户交互的
MSGBOX 对话框
msgResult = MsgBox(" 您想中英标点互换吗 ?按 Y 将中文标点转为英文标点 ,按 N 将英文标 点转为中文标点 !", vbYesNoCancel)
Select Case msgResult
Case vbCancel
Exit Sub ' 如果用户选择了取消按钮 ,则退出程序运行
Case vbYes '如果用户选择了 YES,则将中文标点转换为英文标点
myArray1 = ChineseInterpunction
myArray2 = EnglishInterpunction strFind = "ChineseInterpunction = Array(" II II 。 ....... ；"":""? " " !""……""——""〜” ”
U 5? 5* 5* 5*5 J J J
EnglishInterpunction = Array("," II II ... ":""?" "!""…""_""〜""("")""<"">")
J J J J ・,・,・, J J 5 \ 5 / 5 J / II
(*) strRep = """\1"""
Case vbNo ' 如果用户选择了 NO, 则将英文标点转换为中文标点
myArray1 = EnglishInterpunction
myArray2 = ChineseInterpunction
strRep = " “ \1 ” "
End Select
Application.ScreenUpdating = False ' 关闭屏幕更新
For N = 0 To UBound(ChineseInterpunction) ' 从数组的下标到上标间作一个循环
With ActiveDocument.Content.Find
.ClearFormatting ' 不限定查找格式
.MatchWildcards = False ' 不使用通配符
' 查找相应的英文标点 ,替换为对应的中文标点
.Execute findtext:=myArray1(N), replacewith:=myArray2(N), Replace:=wdReplaceAll
End With
Next
With ActiveDocument.Content.Find
.ClearFormatting ' 不限定查找格式
.MatchWildcards = True ' 使用通配符
.Execute findtext:=strFind, replacewith:=strRep, Replace:=wdReplaceAll
End WithstrFind = linn (*) nnn Application.ScreenUpdating = True
End Sub
4 、任意页插入页码
Sub 任意页插入页码 ()
Dim p As Integer
On Error Resume Next
p = InputBox(" 请输入起始编排页码的页次 ")
With Selection
.GoTo What:=wdGoToPage, Count:=p
.InsertBreak Type:=wdSectionBreakContinuous .Sections(1).Footers(1).LinkToPrevious = False
With .Sections(1).Footers(1).PageNumbers
.RestartNumberingAtSection = True
.StartingNumber = 1
.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True End With
End With
End Sub恢复屏幕更新
5、实现图形的精确旋转
Sub 图形旋转 ()
Dim blnIsInlineShape As Boolean
If Selection.Type = wdSelectionInlineShape Then
blnIsInlineShape = True
Selection.InlineShapes(1).ConvertToShape
End If
Dim intTurn As Integer
intTurn = InputBox(" 请输入图形要旋转的角度值 " & vbCrLf & " 正数表示顺时针，负数表 示逆时针。
", "图形旋转 ", 30)
Selection.ShapeRange.IncrementRotation intTurn
End Sub
注释：上述代码中， 首先是将嵌入式的图形转换为可以自由浮动的图形。 返回 Wo rd 窗口 之后，选中文档中需要旋转的某幅图形， 按下 Alt+F8 组合键，选中列表框中的“图形旋转” 宏，单击“运行”按钮弹出一个对话框， 默认的旋转角度是 30 °，例如设置为“ 33 ”很，快 就可以完成旋转操作。
欢迎下载，谢谢观看！资料仅供参考学习
