请帮忙写个宏代码，实在搞不定

leikaiyi123

谁能指导一下用vb6为word写dll加载项怎么写快捷键代码？就是一打开word自动加载dll后,按快捷键即执行自定义宏。

yangguoyun0

413191246se 发表于 2019-2-20 01:51
* 楼主，你做的改变（指 F5 设置为快捷键）是对的！但是没有必要再建立一个宏。
* 任何时候，在文档中，只 ...

1、前面我描述的可能不清楚，又作了个附件描述我要的；
2、求资料邮件已发（yangguoyun_fuyin@126.com）.

上面的宏用起来很妙，注释看了也不是很懂，待我学了书再慢慢参详，谢谢。

yangguoyun0

413191246se 发表于 2019-2-20 01:51
* 楼主，你做的改变（指 F5 设置为快捷键）是对的！但是没有必要再建立一个宏。
* 任何时候，在文档中，只 ...

想要的word宏——求帮助1.rar (5.56 KB, 下载次数: 0)

2019-2-20 11:11 上传

点击文件名下载附件

1、前面表述的可能不清楚，这回我又做了一个附件表述我的问题；
2、求书籍邮件已发（yangguoyun_fuyin@126.com）；

另：前面给的宏用起来很妙，注释看了也不是很懂，待我看了书再慢慢参详，谢谢。

yangguoyun0

帖子要经审核，我还以为没发帖成功，多发帖了，没法删除，请忽略此贴。

413191246se

11楼朋友：或咨询本坛大神 zhanglei1371 老师，或新建一个宏：AutoExec，在里面写上快捷键指定代码，当 WORD 启动后，会自动执行这个宏的。

413191246se

*  楼主，最大序号我已改为 9999，如果嫌小，继续增加 9 即可（其实序号不必限制，按一次出一个，按着不放即可连续出）。
* 请将前两天的宏全部删除（包括 3 个小宏），换上今天的宏（热键我已经改了）。

1. Sub AutoOpen()
   
2.     If ActiveDocument.FullName Like "*.txt" Then MsgBox "本文档为纯文本！", 0 + 16
   
3.     CustomizationContext = NormalTemplate
   
4.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF3), KeyCategory:=wdKeyCategoryMacro, Command:="插入正文序号"
   
5.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF4), KeyCategory:=wdKeyCategoryMacro, Command:="插入脚注序号"
   
6.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF5), KeyCategory:=wdKeyCategoryMacro, Command:="另存为纯文本"
   
7.     MsgBox "F3：插入正文序号    F4：插入脚注序号    F5：另存为纯文本", 0 + 48, "请按下列热键执行宏！"
   
8. End Sub
   
9. Sub 另存为纯文本()
   
10.     With ActiveDocument
    
11.         .SaveAs FileName:=Left(.FullName, Len(.FullName) - 4) & "_TXT" & ".txt", FileFormat:=wdFormatText
    
12.     End With
    
13.     MsgBox "本文档（纯文本）已保存！", 0 + 48
    
14. End Sub
    
15. Sub 插入正文序号()
    
16.     Dim r As Range, n&, m$, i&, x&, y&, oldName$, NewName$
    
17.     With Selection
    
18.         If Not .Type = wdSelectionIP Then .MoveLeft
    
19.         Set r = .Range
    
20.     End With
    
21.     With ActiveDocument.Content.Find
    
22.         .ClearFormatting
    
23.         .Text = "，，" & "[0-9]{1,2}" '中文全角逗号
    
24.         .Forward = True
    
25.         .MatchWildcards = True
    
26.         Do While .Execute
    
27.             With .Parent
    
28.                 .Font.Color = wdColorRed '红色（本行代码可以删除/注释）
    
29.                 If Len(.Text) = 3 Then x = Right(.Text, 1) Else x = Right(.Text, 2)
    
30.                 If y < x Then y = x
    
31.                 .Start = .End
    
32.                 i = 1
    
33.             End With
    
34.         Loop
    
35.         If i = 1 Then .Parent.Select Else GoTo sk
    
36.         With Selection
    
37.             Do
    
38.                 .MoveStart 1, -1
    
39.             Loop Until .Text Like "，，*"
    
40.             If Len(.Text) = 4 Then n = Right(.Text, 2) Else n = Right(.Text, 1)
    
41.         End With
    
42.     End With
    
43.     r.Select
    
44. sk:
    
45.     If y = 9 Then Exit Sub '最大序号
    
46.     m = y + 1
    
47.     With Selection
    
48.         .TypeText Text:="，，" & m
    
49.         If Len(m) = 1 Then
    
50.             .MoveStart 1, -3
    
51.         Else
    
52.             .MoveStart 1, -4
    
53.         End If
    
54.         .Font.Color = wdColorRed '红色（本行代码可以删除/注释）
    
55.         .MoveRight
    
56.     End With
    
57. End Sub
    
58. Sub 插入脚注序号()
    
59.     Dim n&, x&, y&
    
60. 
    
61.     '查找正文最大序号
    
62.     With ActiveDocument.Content.Find
    
63.         .ClearFormatting
    
64.         .Text = "，，" & "[0-9]{1,2}"
    
65.         .Forward = True
    
66.         .MatchWildcards = True
    
67.         Do While .Execute
    
68.             With .Parent
    
69.                 If Len(.Text) = 3 Then x = Right(.Text, 1) Else x = Right(.Text, 2)
    
70.                 If y < x Then y = x
    
71.                 .Start = .End
    
72.             End With
    
73.         Loop
    
74.     End With
    
75.     If y = 0 Then MsgBox "正文无序号！", 0 + 16: Exit Sub
    
76. 
    
77.     '文尾插入脚注序号
    
78.     With Selection
    
79.         .EndKey Unit:=wdStory
    
80.         .TypeParagraph
    
81.         Do
    
82.             n = n + 1
    
83.             .Font.Color = wdColorPink '粉色(本行代码可删除/注释)
    
84.             .TypeText Text:="，，" & n & "．" & vbCr
    
85.         Loop Until n = y
    
86.         .HomeKey Unit:=wdStory
    
87.     End With
    
88.     ActiveDocument.Paragraphs.Last.Range.Delete
    
89. End Sub

复制代码

413191246se

楼主，VBA 学习资料（两个）我已经发送给你了，请查收！

yangguoyun0

413191246se 发表于 2019-2-21 01:51
*  楼主，最大序号我已改为 9999，如果嫌小，继续增加 9 即可（其实序号不必限制，按一次出一个，按着不放 ...

已经很完美了，谢谢您。

1、最大序号我已改为 9999，知道从哪里改了。
2、插入脚注后，光标想定位在脚注的“，，1.”之后，而不是文章开头。查找“，，1.^p，，2”后，按home，end，位置应该就可以，代码？
3、txt文件默认想用“普通视图、2栏”打开，这样，用Ctrl+滚轮就能将字显示的很大，代码？

不好意思，懒出了境界。

另：我的126邮箱没有收到邮件，原因不明，邮箱地址确认无误。604229264@qq.com这个也是我的邮箱，麻烦您再给发一下资料，谢谢。

yangguoyun0

        ActiveWindow.ActivePane.View.Type = wdNormalView '普通视图打开
        ActiveDocument.PageSetup.TextColumns.SetCount NumColumns:=2 '2栏显示
        ActiveDocument.ActiveWindow.View.Zoom.Percentage = 280 '显示比例280%

——这就好用很多

yangguoyun0

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "，，1^p，，2"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine

——录制了一个查找"，，1^p，，2"的宏，把这些语句插入到“Sub 插入脚注序号()”的最后的“End Sub”前，能很好的定位在脚注“，，1”后了。