吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 2595|回复: 8
收起左侧

[其他原创] 【VBA】OD复制内容到Word格式整理工具

[复制链接]
yakov 发表于 2021-1-20 23:00
我个人每次分析一个软件时,都习惯先开一个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、使用方法,将需要整理格式的部分选择,点击格式整理。

toolbar.jpg

整理前:
before.jpg

整理后:
After.jpg


代码:

[Visual Basic] 纯文本查看 复制代码
001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
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

免费评分

参与人数 2吾爱币 +6 热心值 +2 收起 理由
miqi1314 + 1 + 1 鼓励转贴优秀软件安全工具和文档!
苏紫方璇 + 5 + 1 感谢发布原创作品,吾爱破解论坛因你更精彩!

查看全部评分

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

moranyuyan 发表于 2021-1-20 23:48
谢谢分享
忆江南 发表于 2021-1-21 06:57
tangguokui 发表于 2021-1-21 07:46
学习了。一般都是打开WORD开发工具,一个个删除
wq5883 发表于 2021-1-21 08:05
高手就是不一样,我都是手工整理的。
miqi1314 发表于 2021-1-25 08:34
楼主厉害,学习了!
miqi1314 发表于 2021-2-10 16:37
本帖最后由 miqi1314 于 2021-2-12 15:58 编辑

楼主大大,我用wps运行此代码,显示错误:对象不支持改属性或方法。
 楼主| yakov 发表于 2021-2-12 10:05
从来没用过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吾爱币 +1 热心值 +1 收起 理由
miqi1314 + 1 + 1 谢谢@Thanks!

查看全部评分

miqi1314 发表于 2021-2-12 15:59
感谢楼主大过年的回复!!
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2025-1-26 20:50

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表