Vba代码自动缩进功能的实现.docx

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）