78Vba代码自动缩进功能的实现-第2页
上亿文档资料，等你来发现
78Vba代码自动缩进功能的实现-2
136.；137.strTemp=Left$(strLin；138.；139.SelectCasestrTemp；140.Case&Sub&,；141.Head=2；142.Case&With&；&#Else:&,&quot；143.Head=1；144.Case&If&,&；1
strTemp = Left$(strLine, nPos)138.139.
Select Case strTemp140.
Case &Sub&, &Function&, &Property&141.
Head = 2142.
Case &With&, &For&, &Do&, &While&, &Select&, &Case&, &Else&, &Else:&, &#Else&,&#Else:&, &Enum&, &Type&, &Open&143.
Head = 1144.
Case &If&, &#If&, &ElseIf&, &#ElseIf&145.
If (Len(strLine) = (InStr(1, strLine, & Then&) + 4)) Or InStr(strLine, & _&) & 0Then Head = 1146.
Case &Private&, &Public&, &Friend&147.
nPos = InStr(1, strLine, & Static &)148.
If nPos Then149.
nPos = InStr(nPos + 7, strLine, & &)150.
nPos = InStr(Len(strTemp) + 1, strLine, & &)152.
End If153.
Select Case Mid$(strLine, nPos + 1, InStr(nPos + 1, strLine, & &) - nPos -1)154.
Case &Sub&, &Function&, &Property&155.
Head = 2156.
Case &Enum&, &Type&157.
Head = 1158.
End Select159.
End Select160.161.
IsBlockStart = Head162.
End Function163.164. Private Function IsBlockEnd(strLine As String) As Boolean165.
Dim bOK As Boolean166.
Dim nPos As Integer167.
Dim strTemp As String168.169.
strLine = LTrim(strLine)170.
nPos = InStr(1, strLine, & &) - 1171.
If nPos & 0 Then nPos = Len(strLine)172.173.
strTemp = Left$(strLine, nPos)174.175.
Select Case strTemp176.
Case &Next&, &Loop&, &Wend&, &End Select&, &Case&, &Else&, &#Else&, &Else:&,&#Else:&, &ElseIf&, &#ElseIf&, &End If&, &#End If&, &Close&177.
bOK = True178.
Case &End&179.
bOK = (Len(strLine) & 3)180.
End Select181.
IsBlockEnd = bOK182. End Function183.184. Public Function HandleError() As VbMsgBoxResult185.
HandleError = MsgBox(&代码& & Err.Source & &错误：& & vbCrLf & &详细：& &Err.Description _186.
& vbCrLf & &错误号：& & Err.Number, m_iErrMsg, App.Title) 187. End Function188.189. Function HasCodeModule(VBComp) As Boolean190.
On Error GoTo ErrHandler191.192.
Select Case VBComp.Type193.
Case vbext_ct_ActiveXDesigner194.
HasCodeModule = True195.
Case vbext_ct_ClassModule196.
HasCodeModule = True197.
Case vbext_ct_DocObject198.
HasCodeModule = False199.
Case vbext_ct_MSForm200.
HasCodeModule = True201.
Case vbext_ct_PropPage202.
HasCodeModule = True203.
Case vbext_ct_RelatedDocument204.
HasCodeModule = False205.
Case vbext_ct_ResFile206.
HasCodeModule = False207.
Case vbext_ct_StdModule208.
HasCodeModule = True209.
Case vbext_ct_UserControl210.
HasCodeModule = True211.
Case vbext_ct_VBForm212.
HasCodeModule = True213.
Case vbext_ct_VBMDIForm214.
HasCodeModule = True215.
Case Else216.
HasCodeModule = False217.
End Select218.219. ExitProc:220.
Exit Function221. ErrHandler:222.
Err.Raise Err.Number, &(HasCodeModule:& & VBA.Erl & &)&& & Err.Source,Err.Description223. End Function224.225.226. '获取命令行的主体部分227. Function SplitLine(ByVal CmdLine As String) As String228.
Dim i As Integer, j As Integer, K As Integer, m As Integer, n As Integer, s As String,S1 As String229.
Dim Resu As String230.
If Trim(CmdLine) = && Then SplitLine = CmdLine: Exit Function231. 1:232.
i = InStr(CmdLine, &'&)233.
If i Then234.
j = InStrRev(CmdLine, Chr(34), i, vbTextCompare)235.
If j Then236.
Do While j & 0238.
If j & 1 Then239.
j = InStrRev(CmdLine, Chr(34), j - 1, vbTextCompare)240.
End If243.
K = K + 1244.
If K Mod 2 = 0 Then
''号前有偶数&号246.
Resu = Resu & Left(CmdLine, i - 1)247.
''号前有奇数&号248.
i = InStr(i, CmdLine, Chr(34), vbTextCompare)249.
Resu = Resu & Left(CmdLine, i)250.
CmdLine = Mid(CmdLine, i + 1)251.
GoTo 1252.
End If253.
'有'号但没有&号254.
Resu = Resu & Left(CmdLine, i - 1)255.
End If256.
'没有'号257.
Resu = Resu & CmdLine258.
End If259.260.
SplitLine = Resu261. End Function262.263. Sub ReadCfg()
'读取缩进参数264. Dim s As String, i As Integer, a() As String265.
ReDim sjCfg(5)266.
DefMenuName = Trim(GetSetting(&DllAddin&, &config&, &DefMenuName&)) 267.
DefMenuCaption = Trim(GetSetting(&DllAddin&, &config&, &DefMenuCaption&)) 268.
'If DefMenuCaption = && Then DefMenuCaption = GetFileName(DefMenuName) 269.
s = GetSetting(&DllAddin&, &config&, &cs&)270.
a = Split(s, &,&)271.
If UBound(a) & UBound(sjCfg) + 1 Then272.
s = &4,1,1,0,1,0,1&
a = Split(s, &,&)274.
End If275.
Sj = Val(a(0))276.
For i = 0 To UBound(sjCfg)277.
sjCfg(i) = Val(a(i + 1))278.
Next279. End Sub(三) 把下面代码保存为MyExcelAddin.vbp文件1. Type=OleDll2. Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA.0#0#C:\ProgramFiles\Microsoft Office\Office\MSO9.DLL#Microsoft Office 8.0 Object Library3. Reference=*\G{ACD04-11D1-AE7D-00A0C90F26F4}#1.0#0#C:\ProgramFiles\Common Files\designer\MSADDNDR.TLB#Add-In Designer/Instance Control Library4. Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#e:\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility5. Reference=*\G{0-}#1.3#0#C:\ProgramFiles\Microsoft Office\Office\EXCEL9.OLB#Microsoft Excel 9.0 Object Library6. Designer=Connect.Dsr7. Module=ModIndentC ModIndentCode.bas8. Startup=&(None)&9. HelpFile=&&10. ExeName32=&MyExcelAddin.dll&11. Command32=&&12. Name=&MyExcelAddin&13. HelpContextID=&0&14. Description=&Sample AddIn Project&15. CompatibleMode=&0&16. MajorVer=117. MinorVer=018. RevisionVer=019. AutoIncrementVer=020. ServerSupportFiles=021. VersionCompanyName=&888888&22. CompilationType=023. OptimizationType=024. FavorPentiumPro(tm)=025. CodeViewDebugInfo=026. NoAliasing=027. BoundsCheck=028. OverflowCheck=029. FlPointCheck=030. FDIVCheck=031. UnroundedFP=032. StartMode=133. Unattended=034. Retained=035. ThreadPerObject=036. MaxNumberOfThreads=137. DebugStartupOption=038.39. [MS Transaction Server]40. AutoRefresh=141.(四) dll文件编译打开MyExcelAddin.vbp文件,在Vb工作环境中编译成MyExcelAddin.dll文件.(五) dll文件注册:在开始菜单中选择&运行& ,输入 regsvr32 e:\output\MyExcelAddin.dll(请修改指定dll文件位置),然后回车即可.如果你觉得上述过程太复杂,请直接到下面网址下载所需DLL文件:(六)操作指南:MyExcelAddin.dll注册成功以后,你就可以打开Excel文件,在”工具”菜单下找到”代码缩进”工具条(注意:在Excel中,而不是在Visual Basic 编辑器环境中),点击它就可完成代码自动缩进的功能了. 包含各类专业文献、应用写作文书、文学作品欣赏、幼儿教育、小学教育、各类资格考试、专业论文、高等教育、78Vba代码自动缩进功能的实现等内容。　
　用OFFICE+VBA实现WORD自动阅卷功能_其它技巧_PPT制作技巧_PPT专区。用 OFFICE VBA...&首行缩进错误& & vbCrLf '本行代码测首行缩进 2 字符 Else rightstring = ... 　求一段有关EXCEL自动重算的VBA代码_计算机软件及应用_IT/计算机_专业资料。求一...? 程,快速实现报表系统、进销存、生 产管理、工资绩效等系统! 录制一下宏就... 　设置,页眉页脚,文字的 字体、大小、颜色等,段落设置如行距、首行缩进,艺术字判断,插入图像的大 小、表格边框底纹等等,从技术上给出了实现这些阅卷功能的详细代码。... 　IFIX中一些常用功能的VBA代码_IT/计算机_专业资料。根据现场实际需要做适当修改后...为 实现这步操作,需要修改位于 C:\Program Files\GE Fanuc\Proficy iFIX\LOCAL... 　通过代码实现文档到期自动删除的功能,ppt 的不知道 word 代码如下 其中若代码为...vba 应用示例之语句 (101) Err.Clear ‘清除程序运行过程中所有的错误 工作簿... 　有用的 WORD VBA 代码 1、删除空格 '* +++ '功能简介:删除空格' '* ---Sub 删除空格() Dim FindChar As String, Fcount As Integer, RepChar As String... 　Excel_VBA从关闭的工作簿中取值多种实现方法(代码)_计算机软件及应用_IT/计算机...VBA 没有包含从关关的文件中获取值的方法,但是利用 Excel 处理连接文件的功能,... 　vba代码优化相关_计算机软件及应用_IT/计算机_专业资料。在这个帖子中你将看到下列...而不是实现同样功能的 Left$、LTrim$和 UCase$函数.但是我们必须认识到:前者返... 　bufferVar 然而,下面的代码完成了相同的功能,而且还要快: Text1.Text = Input(F, LOF(F)) 如上述,几种方法都实现了同样的任务;同时,最好的算法也是最优的。...其他国家版本This site in other countries/regions:This site in other countries/regions:查看: 1297|回复: 12|
在线时间26 小时经验274 威望0 性别男最后登录注册时间阅读权限20UID25255积分274帖子精华0分享0
EH初级, 积分 274, 距离下一级还需 76 积分
积分排行4528帖子精华0微积分0
我想把一段选择单元格就给整行上色的代码用宏添加到当前活动工作表中，使用了下面的代码但是一运行这个过程excel就出错重启Sub RowColorChange()Dim Asht As Worksheet, Awb As WorkbookSet Awb = ActiveWorkbookSet Asht = ActiveSheetAwb.VBProject.VBComponents(Asht.Name).CodeModule.AddFromString _"Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)" & Chr(10) & _"& If Target.Row &= 2 Then" & Chr(10) & _"&&&& On Error Resume Next" & Chr(10) & _"&&&& [ChangColor_With1].FormatConditions.Delete" & Chr(10) & _"&&&& Target.EntireRow.Name = ""ChangColor_With1""" & Chr(10) & _"&&&& With [ChangColor_With1].FormatConditions" & Chr(10) & _"&&&&& .Delete" & Chr(10) & _"&&&&& .Add xlExpression, , ""TRUE""" & Chr(10) & _"&&&&& .Item(1).Interior.ColorIndex = 24" & Chr(10) & _"&&&& End With" & Chr(10) & _"& End If"&&& End Sub——我尝试过添加简单的代码比如sub a()msgbox "hi"end sub可以实现我想要的插入代码功能，不知道为什么上面这样的代码就不行，求高手指点一下吧——————————————刚才又尝试了用codemodule.insertlines 方法逐句执行，发现在插入第一句的时候就出错了，难道不能用宏添加的方法创建worksheet的事件响应代码？我的好奇心实在难以抑止，求高手发发慈悲，给我解答一下吧，不然班都没法安心上了[em06]
[此贴子已经被作者于 9:47:03编辑过]
猜你喜欢看
在线时间161 小时经验928 威望0 最后登录注册时间阅读权限30UID149342积分928帖子精华0分享0
EH中级, 积分 928, 距离下一级还需 172 积分
积分排行1161帖子精华0微积分0
在线时间1046 小时经验1497 威望0 性别保密最后登录注册时间阅读权限70UID253168积分2597帖子精华0分享2
EH铁杆, 积分 2597, 距离下一级还需 603 积分
积分排行378帖子精华0微积分0
参考:Private Sub Worksheet_SelectionChange(ByVal Target As Range)I = Target.Range("a1").RowJ = Target.Range("a1").Row + Target.Rows.Count - 1Range(Cells(I, 1), Cells(J, 256)).Interior.ColorIndex = 3End Sub
在线时间26 小时经验274 威望0 性别男最后登录注册时间阅读权限20UID25255积分274帖子精华0分享0
EH初级, 积分 274, 距离下一级还需 76 积分
积分排行4528帖子精华0微积分0
我看了上面给出的链接，发现创建事件是使用CreateEventProc 方法，于是我又试了一下，竟然还是不行，依然是创建selectionchange事件的时候就出错重启excel，我使用的是下面的代码Sub try()Dim Asht As Worksheet, Awb As Workbook, VBS As VBComponentsSet Awb = ActiveWorkbookSet Asht = ActiveSheetSet VBS = Awb.VBProject.VBComponentsVBS(Asht.Name).CodeModule.InsertLines 1, "'test it"VBS(Asht.Name).CodeModule.CreateEventProc "selectionchange", "worksheet"VBS(Asht.Name).CodeModule.InsertLines 3, "'test it again"End Sub后来突然发现，原来这个宏不能单步执行，如果一次直接运行完就没问题，好诡异啊，真希望哪位老大来给点原理性的解释
在线时间161 小时经验928 威望0 最后登录注册时间阅读权限30UID149342积分928帖子精华0分享0
EH中级, 积分 928, 距离下一级还需 172 积分
积分排行1161帖子精华0微积分0
Set VBS = _Application.ThisWorkbook.VBProject.VBComponents& 我运行到这为什么有问题？
在线时间161 小时经验928 威望0 最后登录注册时间阅读权限30UID149342积分928帖子精华0分享0
EH中级, 积分 928, 距离下一级还需 172 积分
积分排行1161帖子精华0微积分0
&&& Application.VBE.ActiveVBProject.VBComponents.Import ("test.bas")你在点Excel中的实行可以看一下？
在线时间26 小时经验274 威望0 性别男最后登录注册时间阅读权限20UID25255积分274帖子精华0分享0
EH初级, 积分 274, 距离下一级还需 76 积分
积分排行4528帖子精华0微积分0
(11.89 KB, 下载次数: 7)
16:22 上传
下载次数: 7
[求助]请教用宏插入代码出错的问题
终于如愿的做成了这个加载宏，功能是在加载后添加一个工具栏按钮，点击可以在当前活动工作表添加一段代码（这是我抄的），该代码实现在选择任意单元格时，将该单元格所处行整行上色，再次点击按钮则删除这段代码。但是还存在一个很大的问题，就是点击运行插入代码的按钮时，总是会弹出VBA编辑器，把添加进去的代码显示出来，求教怎样避免上述情况？（如果我拿这个东西给同事用，一点，弹出一段代码，那可太尴尬了）
在线时间161 小时经验928 威望0 最后登录注册时间阅读权限30UID149342积分928帖子精华0分享0
EH中级, 积分 928, 距离下一级还需 172 积分
积分排行1161帖子精华0微积分0
我这边还是有错！！！Sub RowColorChangeControl()&&& &&& Dim Asht As Worksheet, Awb As Workbook, StartLine As Long, EndLine As Long&&& Set Awb = ActiveWorkbook&&& Set Asht = ActiveSheet&&& With Awb.VBProject.VBComponents(Asht.Name).CodeModule&&&&&&& On Error Resume Next&&&&&&& StartLine = .ProcStartLine("worksheet_selectionchange", vbext_pk_Proc)&&&&&&& If StartLine = 0 Then&&&&&&&&&&& AddRowColorChange&&&&&&& Else&&&&&&& EndLine = .ProcCountLines("worksheet_selectionchange", vbext_pk_Proc)&&&&&&& .DeleteLines StartLine, EndLine&&&&&&& [ChangColor_With1].FormatConditions.Delete&&&&&&& End If&&& End With&&& End Sub
在线时间26 小时经验274 威望0 性别男最后登录注册时间阅读权限20UID25255积分274帖子精华0分享0
EH初级, 积分 274, 距离下一级还需 76 积分
积分排行4528帖子精华0微积分0
继续等高手帮忙guanmy，你的问题不知道和这句话有没有关系：运行前需要 引用 Microsoft Visual Basic For Application Extensibility 5.3
在线时间26 小时经验274 威望0 性别男最后登录注册时间阅读权限20UID25255积分274帖子精华0分享0
EH初级, 积分 274, 距离下一级还需 76 积分
积分排行4528帖子精华0微积分0
未免错过高手指点的机会，自己顶一下
关注我们，与您相约微信公众平台！
Copyright 1999 - 2017 Excel Home. All Rights Reserved.本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！
Powered by
本站特聘法律顾问：徐怀玉律师 李志群律师 &&