ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[原创] 公开源码---VBE环境下创建工具栏(常用代码快捷录入工具)

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2013-9-17 20:28 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:VBE环境开发
本帖最后由 yf_home 于 2013-9-18 09:22 编辑

VBE环境下创建工具栏(常用代码快捷录入工具),
1,源码已公布,Excel版加载宏在 7 楼。
2,一楼为已经封装OK的DLL文件,可以直接使用。

如题,其它就不说了,放两张图。


2003下截图:
VBE2003.png


2010下截图:
VBE2010.png



需要设置:信任对VBA工程对象模型的访问

2003下设置:
2003.png

2010下设置:
2010.png

                                              附件: vbe.zip (32.42 KB, 下载次数: 883)      DLL文件更新了......


声明几点:

1,VBE下新建工具栏,是学习了我买的一本上的用法(不过书上用的是新建右键菜单),我修改了一下变成工具栏。

2,工具中(删除注释、删除空行)的代码来源论坛或网络,由我整理而成。

3,参照了以下两个贴的部分创意(不过这两个贴都没有公开源码):      

      3.1,crazy0qwer 兄的 VBE 小插件--- Office 编程助手http://club.excelhome.net/thread-1055425-1-1.html
      3.2,罗刚君版主 的 VBA代码百宝箱http://club.excelhome.net/thread-1051472-1-1.html

4,感谢liucqa仁兄对自动缩进功能提供的技术支持。



为方便繁体用户的使用,特封装了一个繁体版的DLL文件,以提供繁体用户的使用.
因为我在公司使用的就是繁体版,所以能想到这一点.  
         
                                                                                              VBEToolBars_TW.zip (32.66 KB, 下载次数: 385)





结束语: 请大家试用一下,反馈一下效果。水平有限,高手莫怪........




评分

10

查看全部评分

TA的精华主题

TA的得分主题

发表于 2013-9-17 21:03 | 显示全部楼层
支持创新,更上一层楼

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-17 21:06 | 显示全部楼层
本帖最后由 yf_home 于 2013-9-17 21:18 编辑
东亚五金 发表于 2013-9-17 21:03
支持创新,更上一层楼

感谢支持,试用结果如何?
点击按钮,即可输入代码。支持模块,工作表,窗体。见以下动画:



123.gif







/


TA的精华主题

TA的得分主题

发表于 2013-9-17 21:19 | 显示全部楼层
本帖最后由 liucqa 于 2013-9-17 22:33 编辑

http://www.mrexcel.com/forum/exc ... smart-indenter.html

  1. Sub miApplyIndent()
  2.     Dim aCodePane As VBIDE.CodePane
  3.     Dim aStartLine As Long, aEndLine As Long
  4.     Dim aLineNumber As Long, aStartColumn As Long, aEndColumn As Long
  5.     Dim aLine As String, aIndentLevel As Integer, aLineIsAfterUnderscore As Boolean
  6.     Dim aIncThisIndent As Boolean, aDecThisIndent As Boolean
  7.     Dim aIncNextIndent As Boolean, aDecNextIndent As Boolean
  8.    
  9.     Set aCodePane = ActiveWorkbook.VBProject.VBE.ActiveCodePane
  10.    
  11.     'aCodePane.GetSelection aStartLine, aStartColumn, aEndLine, aEndColumn
  12.     aStartLine = 1
  13.     aEndLine = ThisWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.CountOfLines
  14.     For aLineNumber = aStartLine To aEndLine
  15.         aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
  16.         Do Until Left(aLine, 1) <> " "
  17.             aCodePane.CodeModule.ReplaceLine aLineNumber, Mid(aLine, 2)
  18.             aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
  19.         Loop                        'Loop repeats until all spaces/indents removed
  20.     Next aLineNumber
  21.    
  22.     For aLineNumber = aStartLine To aEndLine
  23.         aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
  24.         Select Case Left(aLine, IIf(InStr(aLine, " ") = 0, 999, InStr(aLine, " ") - 1))
  25.         Case "Do", "For", "Private", "Select", "Sub", "While", "With", "Function"
  26.             aIncNextIndent = True                 'After certain keywords, indent next line
  27.         Case "If"                      'After If, where line ends in Then, indent next line
  28.             If Right(aLine, 4) = "Then" Then aIncNextIndent = True
  29.         Case "Loop", "Next", "End"                 'At Loop, Next, End, un-indent this line
  30.             aDecThisIndent = True
  31.         Case "Case", "Else", "ElseIf"
  32.             aDecThisIndent = True                                   'Un-indent Case or Else
  33.             aIncNextIndent = True                           'Indent line after Case or Else
  34.         End Select
  35.         
  36.         If Right(aLine, 2) = " _" And Not aLineIsAfterUnderscore Then
  37.             aIncNextIndent = True                             'Indent line after underscore
  38.             aLineIsAfterUnderscore = True      'Set a flag to un-indent the line after next
  39.         ElseIf Right(aLine, 2) <> " _" And aLineIsAfterUnderscore Then
  40.             aDecNextIndent = True
  41.             aLineIsAfterUnderscore = False
  42.         End If
  43.         
  44.         If aIncThisIndent Then aIndentLevel = aIndentLevel + 1: aIncThisIndent = False
  45.         If aDecThisIndent Then aIndentLevel = aIndentLevel - 1: aDecThisIndent = False
  46.         On Error GoTo lIndentError
  47.         aCodePane.CodeModule.ReplaceLine aLineNumber, Space$(aIndentLevel * 4) & aLine
  48.         On Error GoTo 0
  49.         If aIncNextIndent Then aIndentLevel = aIndentLevel + 1: aIncNextIndent = False
  50.         If aDecNextIndent Then aIndentLevel = aIndentLevel - 1: aDecNextIndent = False
  51.     Next aLineNumber
  52.     Exit Sub
  53. lIndentError:
  54.     If aIndentLevel < 0 Then aIndentLevel = 0  'Will not happen unless extra lines selected
  55.     Resume Next
  56. End Sub

复制代码




这里有对当前模块自动缩进的代码,你可以发加载宏了,然后可以入知识树


评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-17 21:27 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 yf_home 于 2013-9-17 22:08 编辑
liucqa 发表于 2013-9-17 21:19
http://www.mrexcel.com/forum/exc ... smart-indenter.html

非常感谢,测试结果:只能对所选择的代码进行缩进。

能否帮忙修改一下,实现:
对光标所在的模块区或工作表代码区或窗体代码区,对所有宏(过程)或自定义函数进行缩进。谢谢!




//

TA的精华主题

TA的得分主题

发表于 2013-9-17 23:41 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-18 00:18 | 显示全部楼层



  公布源码,Excel加载宏版的: VBE常用代码快捷输入.zip (25.43 KB, 下载次数: 1224)

   VBA密码:club.excelhome.net


特别感谢: liucqa 仁兄,在对 代码缩进 这个功能上给予的技术支持!


//

点评

这个缩进代码其实还是有很大缺陷的  发表于 2016-9-27 12:53

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2013-9-18 08:16 | 显示全部楼层
本帖最后由 ctp_119 于 2013-9-18 08:48 编辑

感谢分享!!!谢谢!!!

TA的精华主题

TA的得分主题

发表于 2013-9-18 08:26 | 显示全部楼层
支持一下:
  确实对高频使用的代码输入起到好的方便的作用,高效。

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-18 08:44 | 显示全部楼层
zyg365 发表于 2013-9-18 08:26
支持一下:
  确实对高频使用的代码输入起到好的方便的作用,高效。

感谢支持......
你也是属于这相当的级别的高手,这样的小工具,在你那应该属于小儿科了,见笑了.{:soso_e120:}


..
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 18:09 , Processed in 0.055269 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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