【VBA】OD复制内容到Word格式整理工具
我个人每次分析一个软件时，都习惯先开一个Word文档，然后把相关内容记录在里面，但更多的时候，是将OD里的代码复制进来，但是调整格式经常花去很多时间，于是就编写了这个工具。源码说明：
1、为了使用正则，需要在“工具-引用”里添加"Microsoft VBScript Regular Expressions 5.5"的引用；
2、添加自定义工具栏和按钮，暂时只有2个按钮：页面设置和格式整理，OD里复制过来的内容一般比较长，如果采用Word默认的页面设置，大部分地方都需要换行，所以将默认上下边距的2.54和左右的3.17都改为1，增加内容区的范围；
3、格式整理。Word中的Tab键，有着自动对齐的功能，比较好用。OD代码一般分四个部分，第一部分是地址，这部分没有什么变化，比较好处理；第二部分是二进制代码，这部分不太容易确定；第三部分是反汇编代码，都是以小写字母开始的，比较好定位；第四部分是注释部分，都以";"开始，也容易定位。只是每个部分问的Tab数量，如果用代码确定，开始我采用计算的方式，判断文字长度，以4的宽度换算一个Tab，但是，因为英文字母数字是非等宽字体，所以这部分经常不能对齐，因此改变了方式，采用移动光标的方式，动态判断光标的坐标，这种方式比较可靠；
4、使用方法，将需要整理格式的部分选择，点击格式整理。
整理前：
整理后：
代码：
Const TName = "CrackNoteTool"
Sub AutoExec() '启动Word或者加载全局模板时触发，添加自定义的工具栏
With Application.CommandBars.Add(Name:=TName, _
Position:=msoBarTop, Temporary:=True)
.Visible = True
With .Controls.Add(Type:=msoControlButton, ID _
:=1, Before:=1, Temporary:=True) 'ID要设置为1，表示自定义，和Excel里设置2950为自定义不同，要出错
.BeginGroup = False
.OnAction = "Page_Setup"
.FaceId = 501
.Caption = "Page setup"
End With
With .Controls.Add(Type:=msoControlButton, ID _
:=1, Before:=1, Temporary:=True) 'ID要设置为1，表示自定义，和Excel里设置2950为自定义不同，要出错
.BeginGroup = False
.OnAction = "Align_Columns"
.FaceId = 269
.Caption = "Align columns"
End With
End With
End Sub
Sub AutoExit() '退出Word或者卸载全局模板时触发
CommandBars(TName).Delete
End Sub
Sub Page_Setup() '页面设置
With ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(1)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
End With
End Sub
Sub Align_Columns()
Dim s As String, tmp As String
Dim iStart As Long, iEnd As Long, pos As Long, i As Long
Dim reg As New RegExp
Dim m As MatchCollection
Const COL1 = 91.5, COL2 = 175.5, COL3 = 345.5 '各列的位置
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
'OD里复制下来的文本默认是左右对齐，这会使文本分得很散，格式不好控制，所以设置为左对齐
While Right(Selection, 1) = vbCr Or Right(Selection, 1) = vbLf'去掉选择末尾的空行
Selection.End = Selection.End - 1
Wend
iStart = Selection.Start
'iEnd = Selection.End '原来想用这个定位结尾，但是因为整理过程中内容经常会被替换，所以结束位置随时会变化
Selection.MoveRight unit:=wdCharacter, Count:=1 '移动光标到末尾
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="endSelection" '加个书签方便定位，这个防止操作处理过界
Selection.HomeKey unit:=wdStory '回到文档开始
Selection.MoveRight unit:=wdCharacter, Count:=iStart '回到选择开始
While Selection.Start < ActiveDocument.Bookmarks("endSelection").Start
'处理第一个Tab
Selection.MoveRight unit:=wdWord, Extend:=1
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
'处理第2个Tab
Selection.EndKey unit:=wdLine, Extend:=wdExtend '选择到行尾
s = Selection
reg.Pattern = "{2,}\s?" '匹配汇编代码，前面的二进制代码里也会出现字母，但都是用大写字母，所以不会混淆
Set m = reg.Execute(s)
tmp = m.Item(0).Value
pos = InStr(s, tmp) - 1
Selection.End = Selection.Start + pos '这里的选择就是二进制代码
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
If Selection.Information(wdHorizontalPositionRelativeToPage) >= COL2 Then
Selection = " "
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
While Selection.Information(wdHorizontalPositionRelativeToPage) < COL2
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
Wend
End If
'处理第3个Tab
Selection.EndKey unit:=wdLine, Extend:=wdExtend '选择到行尾
s = Selection
pos = InStr(s, ";")
If pos = 0 Then
Selection.MoveRight unit:=wdCharacter, Count:=1 '没有注释部分，后面都是汇编码
Else
Selection.End = Selection.Start + pos - 1 '这里选择的是汇编代码部分
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
If Selection.Information(wdHorizontalPositionRelativeToPage) >= COL3 Then
Selection = " "
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
While Selection.Information(wdHorizontalPositionRelativeToPage) < COL3
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
Wend
End If
Selection.EndKey unit:=wdLine, Extend:=wdExtend
s = Selection
If Right(s, 1) = vbCr Then '防止太长的行有换行
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Selection.MoveRight unit:=wdCharacter, Count:=1
End If
End If
Wend
ActiveDocument.Bookmarks("endSelection").Delete '删除用于临时定位的书签
End Sub
谢谢分享 好代码，感恩楼主的分享！{:1_919:} 学习了。一般都是打开WORD开发工具，一个个删除 高手就是不一样，我都是手工整理的。 楼主厉害，学习了！ 本帖最后由 miqi1314 于 2021-2-12 15:58 编辑
楼主大大，我用wps运行此代码，显示错误：对象不支持改属性或方法。 从来没用过WPS，刚才下载了一个，却提示不能用VBA，需要企业版，又在本站找了个企业版的安装上。
试下了并无问题，你可以照下面修改试试：
ActiveWorkbook.Worksheets("各科临界生").Sort.SortFields.Add2 Key:=Range(Cells(strrow + 1, 4), Cells(maxrow - 1, 4)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
如果还是有问题，可能是版本冲突，造成某个Excel的常量没有定义，出问题的常量只寻找：xlSortOnValues，xlAscending，xlSortNormal，你在立刻窗口中看看能否输出它们的内容，如果不能，就是没有定义了。如果没有定义，可以自己加个常量定义，比如：
const xlSortOnValues = 0
感谢楼主大过年的回复！！
页:
[1]