【VBA】OD复制内容到Word格式整理工具

yakov

我个人每次分析一个软件时，都习惯先开一个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、使用方法，将需要整理格式的部分选择，点击格式整理。



整理前：


整理后：



代码：

[Visual Basic] 纯文本查看 复制代码

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 = "[a-z]{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

moranyuyan

谢谢分享

忆江南

好代码，感恩楼主的分享！

tangguokui

学习了。一般都是打开WORD开发工具，一个个删除

wq5883

高手就是不一样，我都是手工整理的。

miqi1314

楼主厉害，学习了！

miqi1314

楼主大大，我用wps运行此代码，显示错误：对象不支持改属性或方法。

yakov

从来没用过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

miqi1314

感谢楼主大过年的回复！！