[已解决]功能一：一次性删除工程中所有注释行

EZD

我这是提问[em04]

最佳答案

月排行榜 / 总排行榜

amulee

2010-10-26 10:35

这个是罗老师的代码

Sub 删除批注()
  Dim oCodeMod As CodeModule, ProcType As Long, 起始行 As Long, 结束行 As Long
  Dim 过程名称 As String, 光标行 As Long, Item As Long, 注释位置 As Long, CodeRow As String
  Set oCodeMod = Application.VBE.ActiveCodePane.CodeModule
  Application.VBE.ActiveCodePane.GetSelection 光标行, 0, 0, 0  '获取选区第一行行号
  过程名称 = oCodeMod.ProcOfLine(光标行, ProcType)  '获区过程名称
  If 过程名称 <> "" Then
    起始行 = oCodeMod.ProcStartLine(过程名称, ProcType)  '获取过程的起止行行号
    结束行 = (起始行 + oCodeMod.ProcCountLines(过程名称, ProcType)) - 1
    For Item = 结束行 To 起始行 Step -1  '遍历每一行
      CodeRow = oCodeMod.Lines(Item, 1)  '提取一行的代码
      If Len(Trim(CodeRow)) > 0 Then  '如果该行长度大于0
        注释位置 = InStr(1, CodeRow, "'")  '计算单引号的位置
        If 注释位置 > 0 Or InStr(1, CodeRow, "Rem") > 0 Then  '如果有单引号出现或者Rem出现
          '如果第一字符就是单引号，替换成空，否由通过"去批注"函数获取其注释以外的部分
          If 注释位置 = 1 Then CodeRow = "" Else CodeRow = 去批注(CodeRow)
          If Left(Replace(CodeRow, " ", ""), 3) = "Rem" Then CodeRow = ""  '如果左边是Rem则替换成空
          oCodeMod.ReplaceLine Item, CodeRow  '执行替换
        End If
      End If
    Next
  End If
End Sub

跳转到最佳答案楼层

chensir

[em01]

[此贴子已经被作者于2010-10-26 9:30:25编辑过]

amulee

这个是罗老师的代码

Sub 删除批注()
  Dim oCodeMod As CodeModule, ProcType As Long, 起始行 As Long, 结束行 As Long
  Dim 过程名称 As String, 光标行 As Long, Item As Long, 注释位置 As Long, CodeRow As String
  Set oCodeMod = Application.VBE.ActiveCodePane.CodeModule
  Application.VBE.ActiveCodePane.GetSelection 光标行, 0, 0, 0  '获取选区第一行行号
  过程名称 = oCodeMod.ProcOfLine(光标行, ProcType)  '获区过程名称
  If 过程名称 <> "" Then
    起始行 = oCodeMod.ProcStartLine(过程名称, ProcType)  '获取过程的起止行行号
    结束行 = (起始行 + oCodeMod.ProcCountLines(过程名称, ProcType)) - 1
    For Item = 结束行 To 起始行 Step -1  '遍历每一行
      CodeRow = oCodeMod.Lines(Item, 1)  '提取一行的代码
      If Len(Trim(CodeRow)) > 0 Then  '如果该行长度大于0
        注释位置 = InStr(1, CodeRow, "'")  '计算单引号的位置
        If 注释位置 > 0 Or InStr(1, CodeRow, "Rem") > 0 Then  '如果有单引号出现或者Rem出现
          '如果第一字符就是单引号，替换成空，否由通过"去批注"函数获取其注释以外的部分
          If 注释位置 = 1 Then CodeRow = "" Else CodeRow = 去批注(CodeRow)
          If Left(Replace(CodeRow, " ", ""), 3) = "Rem" Then CodeRow = ""  '如果左边是Rem则替换成空
          oCodeMod.ReplaceLine Item, CodeRow  '执行替换
        End If
      End If
    Next
  End If
End Sub

jstz

学习amulee老师的代码

爱疯

QUOTE:

以下是引用amulee在2010-10-26 10:35:00的发言：

这个是罗老师的代码

Sub 删除批注()
  Dim oCodeMod As CodeModule, ProcType As Long, 起始行 As Long, 结束行 As Long
  Dim 过程名称 As String, 光标行 As Long, Item As Long, 注释位置 As Long, CodeRow As String
  Set oCodeMod = Application.VBE.ActiveCodePane.CodeModule
  Application.VBE.ActiveCodePane.GetSelection 光标行, 0, 0, 0  '获取选区第一行行号
  过程名称 = oCodeMod.ProcOfLine(光标行, ProcType)  '获区过程名称
  If 过程名称 <> "" Then
    起始行 = oCodeMod.ProcStartLine(过程名称, ProcType)  '获取过程的起止行行号
    结束行 = (起始行 + oCodeMod.ProcCountLines(过程名称, ProcType)) - 1
    For Item = 结束行 To 起始行 Step -1  '遍历每一行
      CodeRow = oCodeMod.Lines(Item, 1)  '提取一行的代码
      If Len(Trim(CodeRow)) > 0 Then  '如果该行长度大于0
        注释位置 = InStr(1, CodeRow, "'")  '计算单引号的位置
        If 注释位置 > 0 Or InStr(1, CodeRow, "Rem") > 0 Then  '如果有单引号出现或者Rem出现
          '如果第一字符就是单引号，替换成空，否由通过"去批注"函数获取其注释以外的部分
          If 注释位置 = 1 Then CodeRow = "" Else CodeRow = 去批注(CodeRow)
          If Left(Replace(CodeRow, " ", ""), 3) = "Rem" Then CodeRow = ""  '如果左边是Rem则替换成空
          oCodeMod.ReplaceLine Item, CodeRow  '执行替换
        End If
      End If
    Next
  End If
End Sub

If 注释位置 = 1 Then CodeRow = "" Else CodeRow = 去批注(CodeRow)

提示子过程或函数未定义

[em04]

amulee

漏了一段，也是罗老师的

Function 去批注(代码 As String) As String  '返回一行代码中的非注释部分(针对单引号设置的注释)
  Dim iCount As Long, Item As Long
  去批注 = 代码
  For Item = 1 To Len(代码)  '遍历代码中每一个字符
    If Mid(代码, Item, 1) = """" Then  '如果是双引号
      iCount = iCount + 1  '累加计数器
    ElseIf Mid(代码, Item, 1) = "'" Then  '如果是单引号
      If iCount Mod 2 = 0 Then 去批注 = Mid(代码, 1, Item - 1)  '根据单引号的位置提取代码（去除注释后）
    End If
  Next
End Function

EZD

验证通过，只能A个A个过程的删，能否再循环所有工作表、窗体、类模块。。。中的过程，一下整个工程搞定

我动力动笔，实在拿不出来。。。。[em04]

爱疯

QUOTE:

以下是引用EZD在2010-10-26 15:49:00的发言：

验证通过，只能A个A个过程的删，能否再循环所有工作表、窗体、类模块。。。中的过程，一下整个工程搞定

我动力动笔，实在拿不出来。。。。[em04]

想想都恐怖，好在注释不影响代码，难道会有很多不人性化的注释，没有的话忍忍吧：

忍无可忍，继续再忍

[em01]

EZD

那。。。好吧，结贴

[em03]