Vba代码自动缩进功能的实现.docx
- 文档编号:7957859
- 上传时间:2023-01-27
- 格式:DOCX
- 页数:14
- 大小:20.85KB
Vba代码自动缩进功能的实现.docx
《Vba代码自动缩进功能的实现.docx》由会员分享,可在线阅读,更多相关《Vba代码自动缩进功能的实现.docx(14页珍藏版)》请在冰豆网上搜索。
Vba代码自动缩进功能的实现
Vba代码自动缩进功能的实现
喜欢Vba的朋友到知道:
编写宏代码时,如果代码一多,就觉得杂乱无章,没有条理性.如何进行代码自动缩进,就成了紧迫的问题.
下面就介绍实现此功能的DLL文件的编译过程:
一.编译环境:
vb6.0,office2000,Excel2000
二.编译步骤:
(一)把下面代码保存为Connect.Dsr文件:
1.VERSION5.00
2.Begin{AC0714F6-3D04-11D1-AE7D-00A0C90F26F4}Connect
3.ClientHeight=6300
4.ClientLeft=1740
5.ClientTop=1545
6.ClientWidth=11130
7._ExtentX=19632
8._ExtentY=11113
9._Version=393216
10.Description="Add-InProjectTemplate"
11.DisplayName="MyAdd-In"
12.AppName="MicrosoftExcel"
13.AppVer="MicrosoftExcel9.0"
14.LoadName="Startup"
15.LoadBehavior=3
16.RegLocation="HKEY_CURRENT_USER\Software\Microsoft\Office\Excel"
17.End
18.AttributeVB_Name="Connect"
19.AttributeVB_GlobalNameSpace=False
20.AttributeVB_Creatable=True
21.AttributeVB_PredeclaredId=False
22.AttributeVB_Exposed=True
23.OptionExplicit
24.
25.PrivateWithEventssj1AsOffice.CommandBarButton
26.Attributesj1.VB_VarHelpID=-1
27.
28.PrivateSubAddinInstance_OnConnection(ByValApplicationAsObject,ByValConnectModeAsAddInDesignerObjects.ext_ConnectMode,ByValAddInInstAsObject,custom()AsVariant)
29.OnErrorResumeNext
30.Setxlapp=Application
31.'=================================在<我的的工具>工具栏创建"试验按钮1"==================================
32.xlapp.CommandBars("tools").Controls("代码缩进").Delete
33.Setsj1=xlapp.CommandBars("tools").Controls.Add(Type:
=msoControlButton)
34.Withsj1
35..Caption="代码缩进"
36..Style=msoButtonIconAndCaption
37.EndWith
38.EndSub
39.
40.PrivateSubAddinInstance_OnDisconnection(ByValRemoveMode_
41.AsAddInDesignerObjects.ext_DisconnectMode,custom()AsVariant)
42.OnErrorResumeNext
43.AddinInstance_Terminate
44.EndSub
45.
46.PrivateSubAddinInstance_Terminate()
47.OnErrorResumeNext
48.xlapp.CommandBars("tools").Controls("代码缩进").Delete
49.Setxlapp=Nothing
50.EndSub
51.
52.PrivateSubsj1_Click(ByValCtrlAsOffice.CommandBarButton,CancelDefaultAsBoolean)
53.IndentCode
54.EndSub
(二)把下面代码保存为ModIndentCode.bas文件:
1.AttributeVB_Name="ModIndentCode"
2.OptionExplicit
3.
4.PublicConstm_iErrMsgAsInteger=vbAbortRetryIgnore+vbCritical
5.PublicSjAsByte,sjCfg()AsByte,DefMenuNameAsString,DefMenuCaptionAsString'参数变量:
sj=每行缩进的空格数***
6.PublicUndoCsAsInteger'撤消次数
7.PublicxlappAsObject
8.
9.SubIndentCode()
10.DimmCode,FuncNameAsString,iAsLong
11.DimobjMember
12.DimLine1AsLong,Line2AsLong,Line3AsLong,Line4AsLong,DeclarLinesAsLong
13.DimsAsString,S1AsString
14.ReadCfg
15.OnErrorGoTo1
16.SetmCode=xlapp.ActiveWorkbook.VBProject.VBComponents
17.Fori=1TomCode.Count
18.SetobjMember=mCode(i).CodeModule
19.DeclarLines=objMember.CountOfDeclarationLines
20.Line1=1'过程的起始行
21.Line2=objMember.CountOfLines'过程的总行数
22.IfLine2>0Then
23.S1=IndentCode1(objMember,Line1,Line1+Line2-1)&vbNewLine
24.objMember.DeleteLinesLine1,Line2
25.objMember.InsertLines1,S1
26.'objMember.ReplaceLineLine1,S1
27.'mCode.AddFromStringS1
28.'MsgBoxS1
29.'ExitFor
30.EndIf
31.Next
32.MsgBox"代码自动缩进已完成!
",,"提示"
33.ExitSub
34.1:
35.MsgBox"错误号:
"&Err.Number&vbNewLine&"错误信息:
"&Err.Description,vbCritical,"出错提示"
36.EndSub
37.
38.PublicFunctionIndentCode1(ByValmCode,OptionalLine1AsLong,OptionalLine2AsLong)
39.DimnIndentAsInteger
40.DimnLineAsLong
41.DimstrNewLineAsString,strNewLine1AsString,OldLineAsString,SrcDmAsString
42.DimsAsString,S1AsString,iAsInteger
43.Dima()AsString,khAsLong
44.
45.'对入口参数进行处理
46.SelectCaseTypeName(mCode)
47.Case"CodeModule"
48.IfLine1<1ThenLine1=1
49.IfLine2 50.Case"String()" 51.IfLine1 52.IfLine2 53.CaseElse 54.ExitFunction 55.EndSelect 56. 57.ReDima(Line1ToLine2) 58.FornLine=Line1ToLine2 59.'取出每行代码 60.IfTypeName(mCode)="CodeModule"Then 61.strNewLine=mCode.Lines(nLine,1) 62.Else 63.strNewLine=mCode(nLine) 64.EndIf 65.SrcDm=strNewLine 66.s=strNewLine 67. 68.'把每行代码分离成代码和注释部分 69.strNewLine=SplitLine(s) 70.strNewLine1=Mid(s,Len(strNewLine)+1)'注释 71.strNewLine=Trim(strNewLine)'代码 72.IfstrNewLine<>""AndstrNewLine1<>""ThenstrNewLine1=Space$(Sj)&strNewLine1 73.IfsjCfg (2)=1ThenstrNewLine1=""'删除注释*** 74. 75.IfnLine>Line1Then 76.'删除双行空白行*** 77.IfsjCfg(3)=1AndsjCfg(4)=0AndLTrim(strNewLine)=""AndstrNewLine1=""Anda(nLine-kh-1)=""Then 78.kh=kh+1 79.EndIf 80.IfsjCfg(4)=1AndLTrim(strNewLine)=""AndstrNewLine1=""Then 81.kh=kh+1'删除全部空白行*** 82.GoTo1 83.EndIf 84.EndIf 85. 86.'进行缩放处理,把结果存放到数组中 87.IfIsBlockEnd(strNewLine)ThennIndent=nIndent-1'关键字结束,下行减少一个缩进单位 88.IfnIndent<0ThennIndent=0 89.'Putbacknewline. 90.IfInStr(OldLine,"_")=0Then'正常行 91.a(nLine-kh)=IIf(strNewLine&strNewLine1="","",Space$(nIndent*Sj)&strNewLine&strNewLine1) 92.IfstrNewLine=""AndstrNewLine1<>""AndsjCfg (1)=0Thena(nLine-kh)=SrcDm'注释缩进*** 93.OldLine=IIf(strNewLine="","",Space$(nIndent*Sj)&strNewLine)'保存当前行(为判断折行做准备) 94.Else'折行 95.S1=LTrim(OldLine) 96.i=InStr(S1,"") 97.a(nLine-kh)=Space$(Len(OldLine)-Len(S1)+i)&strNewLine&strNewLine1 98.IfInStr(strNewLine,"_")=0ThenOldLine="" 99.EndIf 100.i=IsBlockStart(strNewLine) 101.Ifi>0Then 102.nIndent=nIndent+1'关键字开始,下行增加一个缩进单位 103.Ifi=2Then'在程序中缩进*** 104.a(nLine-kh)=LTrim(a(nLine-kh)) 105.Ifa(nLine-kh)<>""AndsjCfg(5)=1AndsjCfg(4)=0Then'过程函数名称前加一空行*** 106.S1="1" 107.IfnLine-kh>1ThenS1=Trim(a(nLine-kh-1)): IfLeft(S1,1)="'"ThenS1="" 108.IfLen(S1)>0Thena(nLine-kh)=vbNewLine&a(nLine-kh) 109.EndIf 110.nIndent=1 111.EndIf 112.EndIf 113.1: 114.Next 115. 116.'把数组一次性更新到模块中 117.i=Line2-kh 118.ReDimPreservea(Line1Toi) 119.S1=Join(a,vbNewLine) 120. 121.Ifa(Line1)<>""AndLine1>1AndsjCfg(5)=1AndsjCfg(4)=0Then'过程函数名称前加一空行*** 122.S1=vbNewLine&S1 123.EndIf 124.IfRight(S1,4)=vbNewLine&vbNewLineThenS1=Left(S1,Len(S1)-2) 125.IndentCode1=S1 126.EndFunction 127. 128.PrivateFunctionIsBlockStart(strLineAsString)AsInteger 129.DimnPosAsInteger 130.DimstrTempAsString 131.DimHeadAsInteger'函数头标识 132. 133.strLine=LTrim(strLine) 134.nPos=InStr(1,strLine,"")-1 135.IfnPos<0ThennPos=Len(strLine) 136. 137.strTemp=Left$(strLine,nPos) 138. 139.SelectCasestrTemp 140.Case"Sub","Function","Property" 141.Head=2 142.Case"With","For","Do","While","Select","Case","Else","Else: ","#Else","#Else: ","Enum","Type","Open" 143.Head=1 144.Case"If","#If","ElseIf","#ElseIf" 145.If(Len(strLine)=(InStr(1,strLine,"Then")+4))OrInStr(strLine,"_")>0ThenHead=1 146.Case"Private","Public","Friend" 147.nPos=InStr(1,strLine,"Static") 148.IfnPosThen 149.nPos=InStr(nPos+7,strLine,"") 150.Else 151.nPos=InStr(Len(strTemp)+1,strLine,"") 152.EndIf 153.SelectCaseMid$(strLine,nPos+1,InStr(nPos+1,strLine,"")-nPos-1) 154.Case"Sub","Function","Property" 155.Head=2 156.Case"Enum","Type" 157.Head=1 158.EndSelect 159.EndSelect 160. 161.IsBlockStart=Head 162.EndFunction 163. 164.PrivateFunctionIsBlockEnd(strLineAsString)AsBoolean 165.DimbOKAsBoolean 166.DimnPosAsInteger 167.DimstrTempAsString 168. 169.strLine=LTrim(strLine) 170.nPos=InStr(1,strLine,"")-1 171.IfnPos<0ThennPos=Len(strLine) 172. 173.strTemp=Left$(strLine,nPos) 174. 175.SelectCasestrTemp 176.Case"Next","Loop","Wend","EndSelect","Case","Else","#Else","Else: ","#Else: ","ElseIf","#ElseIf","EndIf","#EndIf","Close" 177.bOK=True 178.Case"End" 179.bOK=(Len(strLine)>3) 180.EndSelect 181.IsBlockEnd=bOK 182.EndFunction 183. 184.PublicFunctionHandleError()AsVbMsgBoxResult 185.HandleError=MsgBox("代码"&Err.Source&"错误: "&vbCrLf&"详细: "&Err.Description_ 186.&vbCrLf&"错误号: "&Err.Number,m_iErrMsg,App.Title) 187.EndFunction 188. 189.FunctionHasCodeModule(VBComp)AsBoolean 190.OnErrorGoToErrHandler 191. 192.SelectCaseVBComp.Type 193.Casevbext_ct_ActiveXDesigner 194.HasCodeModule=True 195.Casevbext_ct_ClassModule 196.HasCodeModule=True 197.Casevbext_ct_DocObject 198.HasCodeModule=False 199.Casevbext_ct_MSForm 200.HasCodeModule=True 201.Casevbext_ct_PropPage 202.HasCodeModule=True 203.Casevbext_ct_RelatedDocument 204.HasCodeModule=False 205.Casevbext_ct_ResFile 206.HasCodeModule=False 207.Casevbext_ct_StdModule 208.HasCodeModule=True 209.Casevbext_ct_UserControl 210.HasCodeModule=True 211.Casevbext_ct_VBForm 212.HasCodeModule=True 213.Casevbext_ct_VBMDIForm 214.HasCodeModule=True 215.CaseElse 216.HasCodeModule=False 217.EndSelect 218. 219.ExitProc: 220.ExitFunction 221.ErrHandler: 222.Err.RaiseErr.Number,"(HasCodeModule: "&VBA.Erl&")>"&Err.Source,Err.Description 223.EndFunction 224. 225. 226.'获取命令行的主体部分 227.FunctionSplitLine(ByValCmdLineAsString)AsString 228.DimiAsInteger,jAsInteger,KAsInteger,mAsInteger,nAsInteger,sAsString,S1AsString 229.DimResuAsString 230.IfTrim(CmdLine)=""ThenSplitLine=CmdLine: ExitFunction 231.1: 232.i=InStr(CmdLine,"'") 233.IfiThen 234.j=InStrRev(CmdLine,Chr(34),i,vbTextCompare) 235.IfjThen 236.K=0 237.DoWhilej>0 238.Ifj>1Then 239.j=InStrRev(CmdLine,Chr(34),j-1,vbTextCompare)
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Vba 代码 自动 缩进 功能 实现