ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2633|回复: 22

[求助] 请帮忙写个宏代码,实在搞不定

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-2-15 23:49 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
想要的word宏:
鼠标点在某一处,按F3(可以定义别的键),可以在光标处加入了“,,序号”。
也就是:
打开一个新文件,将光标移到特定位置,摁一下“F3”,执行一下宏,在光标位置插入“,,1”,再将光标移到特定位置,摁一下“F3”,执行一下宏,在光标位置插入“,,2”,……存盘退出,参数重置——这样一个宏该怎么写?
最后效果:
鼠标点,,1在某,,2一处,按F3(,,3可以定义别的键),可以在光标处加入了“,,序号”。
试了一个宏:
Sub F3在光标处插入双逗号()
' F3在光标处插入双逗号
    For i = 1 To 40
        Selection.TypeTextText:=",," &Trim(Str$(i))
    Next i
End Sub
问题是:
1)按一下F3运行宏,“,,1,,2,,3,,4,,5,,6,,7,,8,,9,,10,,11,,12,,13,,14,,15,,16,,17,,18,,19,,20,,21,,22,,23,,24,,25,,26,,27,,28,,29,,30,,31,,32,,33,,34,,35,,36,,37,,38,,39,,40”这一堆一起出来了,没有摁一下出一个。
2)摁几下出几个序号,可大于或小于40个序号。




想要的word宏——求帮助.rar

3.45 KB, 下载次数: 4

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 08:12 | 显示全部楼层
1、怎样能让word知道我按的是F3键;2、循环的执行和退出的控制;——接触的少,都不会。

TA的精华主题

TA的得分主题

发表于 2019-2-16 08:52 来自手机 | 显示全部楼层
每执行一次宏,i从1到40循环一次,得到的当然是上面结果,插入域试试吧。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 08:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
leikaiyi123 发表于 2019-2-16 08:52
每执行一次宏,i从1到40循环一次,得到的当然是上面结果,插入域试试吧。

域更不会弄,最终的文本要存成txt用,最好直接能达到目的的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-16 09:49 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
翻了本版近10页的帖子,没有找到方法,求帮助。

TA的精华主题

TA的得分主题

发表于 2019-2-17 03:39 | 显示全部楼层
* 楼主,过年好!我给你写了一个宏,请测试一下,但请注意:
* 如果文档已经打开,请关闭重新打开一下。
* 按提示,在打开的文档中, F3 键:插入序号,F4 键:另存为纯文本文档(默认保存在原文档文件夹)。
* 如果不再需要这个宏,可以保存起来,但为了避免麻烦,请将 AutoOpen宏改名为 AutoOpen999 或删除也可(删除方法是:在 Word 界面按 Alt + F8 打开宏名列表,选中 AutoOpen 宏,点击右面“删除”按钮,再按”确定“即可,包括 3 个小宏,放在 VBE 中。方法是:按 Alt + F8 随便选中一个宏,点击“编辑”进入到 VBE 中,再按组合键 Ctrl+Home 到代码最后面,粘贴上我的 3 个小宏;使用时只需按 F3 插入序号,F4另存为TXT)。
  1. Sub AutoOpen()
  2.     CustomizationContext = NormalTemplate
  3.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF3), KeyCategory:=wdKeyCategoryMacro, Command:="插入序号"
  4.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF4), KeyCategory:=wdKeyCategoryMacro, Command:="另存为纯文本"
  5.     MsgBox "F3:插入序号    F4:另存为纯文本", 0 + 48
  6. End Sub
  7. Sub 另存为纯文本()
  8.     ActiveDocument.SaveAs FileName:=Left(ActiveDocument.FullName, Len(ActiveDocument.FullName) - 4) & "_TXT" & ".txt", FileFormat:=wdFormatText
  9.     ActiveDocument.Close
  10. End Sub
  11. Sub 插入序号()
  12.     Dim r As Range, n&, m$, i&, x&, y&, oldName$, NewName$
  13.     With Selection
  14.         If Not .Type = wdSelectionIP Then .MoveLeft
  15.         Set r = .Range
  16.     End With
  17.     With ActiveDocument.Content.Find
  18.         .ClearFormatting
  19.         .Text = ",," & "[0-9]{1,2}" '中文逗号
  20.         .Forward = True
  21.         .MatchWildcards = True
  22.         Do While .Execute
  23.             With .Parent
  24.                 .Font.Color = wdColorRed '红色(本行代码可以删除)
  25.                 If Len(.Text) = 3 Then x = Right(.Text, 1) Else x = Right(.Text, 2)
  26.                 If y < x Then y = x
  27.                 .Start = .End
  28.                 i = 1
  29.             End With
  30.         Loop
  31.         If i = 1 Then .Parent.Select Else GoTo sk
  32.         With Selection
  33.             Do
  34.                 .MoveStart 1, -1
  35.             Loop Until .Text Like ",,*"
  36.             If Len(.Text) = 4 Then n = Mid(.Text, 3, 2) Else n = Right(.Text, 1)
  37.         End With
  38.     End With
  39.     r.Select
  40. sk:
  41.     If y = 40 Then Exit Sub '最大序号
  42.     m = y + 1
  43.     With Selection
  44.         .TypeText Text:=",," & m
  45.         If Len(m) = 1 Then
  46.             .MoveStart 1, -3
  47.         Else
  48.             .MoveStart 1, -4
  49.         End If
  50.         .Font.Color = wdColorRed '红色(本行代码可以删除)
  51.         .MoveRight
  52.     End With
  53. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-19 09:34 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
413191246se 发表于 2019-2-17 03:39
* 楼主,过年好!我给你写了一个宏,请测试一下,但请注意:
* 如果文档已经打开,请关闭重新打开一下。
...

您做的很好,完全超过了我的所求所想,就是我要的,谢谢。

您把这东西做的这么方便,但看代码,因个人基础的原因,我又不知其所以然,做不到触类旁通,还想恳请您在得空的时候能给尽可能详尽的注释一下,我好一窥堂奥(现在工作已经不挡手了,预期得干几个月,求注释的事情不急,还望一年半载的您有空的时候不吝赐教)。

祝节日快乐,吉庆有余!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-19 17:27 | 显示全部楼层
413191246se 发表于 2019-2-17 03:39
* 楼主,过年好!我给你写了一个宏,请测试一下,但请注意:
* 如果文档已经打开,请关闭重新打开一下。
...

问题:F5文末插入脚注如下:

,,1
,,2
……    '直到上面宏的最大的序号,这个怎么弄?

个人的学习、尝试:

    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF5), KeyCategory:=wdKeyCategoryMacro, Command:="文末插入脚注"

——用这个能调动小宏“Sub 文末插入脚注()”

    Selection.EndKey Unit:=wdStory
      Selection.TypeParagraph                     

——用这个能到文末并换行。

难点:上面宏的最大的序号是哪个参数?怎么的循环一次在文末插入脚注序号从1到最大?谢谢。

TA的精华主题

TA的得分主题

发表于 2019-2-20 01:33 | 显示全部楼层
* 楼主,用代码指定快捷键也可以,但我推荐你使用手动指定快捷键的方法,具体如下:
*
* Word快捷键自定义:
工具/自定义/键盘/类别/宏/找到某个宏/请按新快捷键(比如:按一下 F4)/指定/当前快捷键为:F4/关闭/
关闭

TA的精华主题

TA的得分主题

发表于 2019-2-20 01:51 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
* 楼主,你做的改变(指 F5 设置为快捷键)是对的!但是没有必要再建立一个宏。
* 任何时候,在文档中,只须按组合键 Ctrl + Home 即到文尾,再打一下回车,然后你继续按 F3 即可。
* 代码中你看到没有?有一处写着“'最大序号”,40 是你规定的,你把它改为任何数字均可(一次一下,你可以按着 F3 不松手,它会一直出到 40,如果把最大序号改为 400,它会出到 400)。
* 楼主,建议你给我邮箱发一封信,我给你发一个《Word2003VBA微软官方帮助》,反复认真学习一下。因为我也是学习了这个帮助,再加上看了一本电子书《VBA从入门到精通第二版》,才会了一些 VBA 知识。
* 我的邮箱:ln1400014884@163.com
* 下面是你要的解释:
  1. Sub 插入序号_注释()
  2.     Dim r As Range, n&, m$, i&, x&, y&, oldName$, NewName$ '声明变量
  3.    
  4.     With Selection 'With...End With结构,避免多次调用对象
  5.         '.Type = wdSelectionIP 表示未选定,Not 表示否定,两者加起来表示:已选定!
  6.         If Not .Type = wdSelectionIP Then .MoveLeft '如果选定则向左移动一字符(防止:工具/选项/编辑/标签中默认的<键入内容替换所选内容>,只能插入不能覆盖)
  7.         Set r = .Range '设置区域(Range译成中文即“区域”。记住原位置,就是你点击鼠标后光标所在点)
  8.     End With
  9.    
  10.     With ActiveDocument.Content.Find '全文查找
  11.         .ClearFormatting '清除格式(查找中的格式设置初始化,这句代码最好每次都要写上,否则有时会看到字符但找不到)
  12.         .Text = ",," & "[0-9]{1,2}" '中文逗号
  13.         .Forward = True '向前搜索(即向文档下方搜索)
  14.         .MatchWildcards = True '勾选“使用通配符”
  15.         
  16.         Do While .Execute '循环执行(查找)
  17.             With .Parent 'Parent父对象,意指 .Execute 的上一级对象,即 .Find 对象
  18.                 .Font.Color = wdColorRed '红色(本行代码可以删除)'字体/颜色/红色
  19.                 If Len(.Text) = 3 Then x = Right(.Text, 1) Else x = Right(.Text, 2) '查找文本字长为 3 则 x 值,否则字长为 4 则 x 值
  20.                 If y < x Then y = x '判断最大值(y 为最大值)
  21.                 .Start = .End '起点被赋值为终点(意即下次查找起点位置已经设置为本次查找的终点位置)
  22.                 i = 1 '参数,找到=1,未找到=0
  23.             End With
  24.         Loop '循环结束
  25.         
  26.         If i = 1 Then .Parent.Select Else GoTo sk '如果找到,则选定/否则如果未找到(即文档中找不到“,,数字”)转到<行标> sk 下面一行继续执行
  27.         
  28.         With Selection
  29.             Do 'Do...Loop 循环控制语句
  30.                 .MoveStart 1, -1 '将选定内容向开始处移动一个字符(1 代表字符,-1 代表方向向左)
  31.             Loop Until .Text Like ",,*" '直到选定文本像",,*"循环才停止
  32.             If Len(.Text) = 4 Then n = Mid(.Text, 3, 2) Else n = Right(.Text, 1) '条件判断语句:如果字长为 4,则 n 值;否则字长为 3 则 n 值
  33.         End With
  34.     End With
  35.    
  36.     r.Select '返回原位置(即启动程序前光标所在位置)

  37. '下面 sk: 代表<行标>,过去初级 BASIC 中有<行号>,如 5,10,15 等数字,但<行标>比<行号>更好记,但尽量不要用<行标><<行号>
  38. sk:

  39.     If y = 40 Then Exit Sub '最大序号(条件判断语句 IF 语句。如果最大值 y=40 则退出子程序/本过程,40 可以更改为 50 或其它)
  40.     m = y + 1 '赋值语句(m 被赋值为 y+1,这句代码其实是因为 y 在下面语句中数据类型不对,故而赋给 m)
  41.    
  42.     With Selection
  43.         .TypeText Text:=",," & m '在光标处键入文本内容
  44.         If Len(m) = 1 Then 'IF...Then...Else 条件判断语句(如果 m 值的字长为 1,则
  45.             .MoveStart 1, -3 '将选定内容向开始处移动 3 个字符(简写,1 表示字符,-3 表示向左移动的字符/如果为正值则向右)
  46.         Else '否则
  47.             .MoveStart 1, -4 '将选定内容向开始处移动 4 个字符,简写。标准写法:Selection.MoveStart Unit:=wdCharacter, Count:=-4
  48.         End If '判断语句结束标志
  49.         .Font.Color = wdColorRed '红色(本行代码可以删除)'字符/红色
  50.         .MoveRight '向右移动一个字符,避免选中。简写。标准写法:Selection.MoveRight Unit:=wdCharacter, Count:=1
  51.     End With
  52. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 06:05 , Processed in 0.041888 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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