如何在VBA代码中添加行号？

xiaomi123ok · 发表于 2010-4-26 17:02

如何在VBA代码中添加行号？
比如：下面代码中前方的#001等。
#001  Sub RngSelect()
#002    Sheet1.Range("A3:F6, B1:C5").Select
#003  End Sub

加上前方的行号，目的只是用来解释说明用的，简单的方法就用5楼“山风”先生的方法，复杂的就用“老朽”的加载宏。
其实，加上前方的行号，代码就不能运行了。要复制到VBA编辑器中的话，还要删除掉的。
谢谢各位大侠！

[ 本帖最后由 xiaomi123ok 于 2010-4-27 11:01 编辑 ]

cflood · 发表于 2010-4-26 17:15

要这个有什么用？

dsmch · 发表于 2010-4-26 17:16

不明白楼主为何这样做？

boatwxp · 发表于 2010-4-26 17:53

有这方面的小软件，用于自动添加的。你可以自己搜一下

山风 · 发表于 2010-4-26 18:22

如何在VBA代码中添加行号？

1、在代码表中加入行号，代码是不能运行的
2、如果是为了说明代码，可以将代码放到工作表中第2列，然后，在第1列输入编号（所谓行号）即可

lb_bn · 发表于 2010-4-26 18:30

用非vbe的ide，有的有这个功能。

zldccmx · 发表于 2010-4-26 18:42

使用老朽这个加载宏

[源码全公开]让你在论坛发布彩色VBA代码
http://club.excelhome.net/thread-470541-1-1.html

If MsgBox("是否需要添加行标?", vbYesNo + vbQuestion, "系统提示：") = vbYes Then Hb = True Else Hb = False

[ 本帖最后由 zldccmx 于 2010-4-26 18:59 编辑 ]

zldccmx · 发表于 2010-4-26 18:56

将原来加载宏中　

Private Sub Convertor(ByRef Txt, Hb As Boolean)
Dim Lf As Long, Tp As Long, Wd As Long, Ht As Long, i As Long, Falg As Boolean, Flag As Boolean
Dim Tmp As String, K&, StartLine&, J&, Hr&, Pr, Mt&
Dim CodeMod As CodeModule, Pane As CodePane
Dim HrLine()
On Error GoTo 0
If Application.VBE.MainWindow.Visible = False Then
MsgBox "执行本程式请先开启VBE视窗", vbCritical, AppName
Exit Sub
End If
Set Pane = Application.VBE.ActiveCodePane
If Err.Number <> 0 Then
MsgBox "您未勾选信任存取 Visual Basic 专案", vbCritical, AppName
Exit Sub
End If
Set CodeMod = Pane.CodeModule
'取得每个程序的所在列(日后THML要插入水平线的列数)
With CodeMod
K = 0
StartLine = .CountOfDeclarationLines + 1 '略过宣告区
Do Until StartLine >= .CountOfLines
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), _
vbext_pk_Proc)
ReDim Preserve HrLine(K)
HrLine(K) = StartLine
K = K + 1
Loop
End With
Lf = 1
Ht = CodeMod.CountOfLines '全部程式码的列数
'档名 & 模组名称
Txt = "<head><title>" & Pane.Window.Caption & _
"- Html" & "</title></head>"
' Verdana 字体
Txt = Txt & ""
IExp.document.writeln Txt
For i = 1 To Ht
Tmp = CodeMod.Lines(i, 1)
If Trim(Tmp) <> "" Then
If Not (Flag Or Left(Trim(Tmp), 1) = "'" Or Len(Trim(Tmp)) = 0) Then
If Right(Trim(Tmp), 2) = " _" Then Flag = True Else Flag = False
Select Case Split(Trim(Tmp), " ")(0)
Case "Sub", "Function"
J = 0
Case "Private", "Public"
Select Case Split(Trim(Tmp), " ")(1)
Case "Sub", "Function"
J = 0
End Select
End Select
J = J + 1
If Hb Then Tmp = " #" & Format(J, "000") & " " & Tmp
' If Hb Then Tmp = "" & Format(J, "000:") & "" & Tmp
If J = 1 Then Tmp = "" & " '撰写:" & NA_M & vbCrLf & " '网址:" & Http & vbCrLf & " '日期:" & Now & "" & vbCrLf & Tmp
Else
If Right(Trim(Tmp), 2) = " _" Then Flag = True Else Flag = False
' If Left(Trim(Tmp), 1) = "'" Or Len(Trim(Tmp)) = 0 Then Falg = False Else Falg = True
End If
If i <= CodeMod.CountOfDeclarationLines Then
'处里宣告区的程式码
ConvertCode Tmp, True
Hr = CodeMod.CountOfDeclarationLines
Else
' 处理主程序程式码
ConvertCode Tmp, True
Pr = CodeMod.ProcOfLine(i, vbext_pk_Proc)
End If
If i - 1 = Hr And Hr <> 0 Then
'插入水平线 <" & "hr" & ">"
IExp.document.writeln "<" & "hr" & ">"
End If
On Error Resume Next
Mt = Application.WorksheetFunction.Match(i, HrLine(), 0)
On Error GoTo 0
If Mt > 0 Then
IExp.document.writeln "<" & "hr" & ">"
Mt = 0
End If
Txt = Tmp & "<" & "br" & ">"
IExp.document.writeln Txt 'IIf(Flag Or j = 0, "", Format(j, "000:")) & Txt
End If
Next i
IExp.document.writeln ""
End Sub

复制代码

中的一行代码作如下修改即可！　

If Hb Then Tmp = " #" & Format(J, "000") & " " & Tmp

复制代码

zldccmx · 发表于 2010-4-26 19:01

完成样式：

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-4-26 下午 07:01:22
#001 Sub init()
'引用　Microsoft Scripting Runtime
'Dim Dic As New Dictionary
#002 Set Dic = CreateObject("Scripting.Dictionary")
#003 arr = Sheet1.UsedRange
#004 For i = UBound (arr) To 2 Step -1
#005       Dic(arr(i, 1) & Chr(10) & arr(i, 2)) = arr(i, 3) & Chr(10) & arr(i, 4)
#006 Next
#007 End Sub
   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2010-4-26 下午 07:01:22
#001 Private Sub Worksheet_Change(ByVal Target As Range )
#002 If Target.Count > 1 Or Target.Column > 2 Then Exit Sub
#003 If Dic Is Nothing Then Call init
#004 Application.EnableEvents = False
#005 If Dic.Exists(Cells(Target.Row, 1) & Chr(10) & Cells(Target.Row, 2)) Then
#006       Cells(Target.Row, 3).Resize(1, 2) = Split(Dic(Cells(Target.Row, 1) & Chr(10) & Cells(Target.Row, 2)), Chr(10))
#007 End If
#008       Application.EnableEvents = True
#009 End Sub

boatwxp · 发表于 2010-4-26 19:18

老朽老师的加载宏不错，下载学习！

		自动登录	找回密码
密码			免费注册

[求助] 如何在VBA代码中添加行号？