Question

我想评论包含来自另一个代码VBA的Msg Box的行。我正在尝试使用Library VBA EXTENSIBILITY，但我没有找到解决方案。

欢迎任何帮助。

这是我的代码：

Sub CommentCode()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const QUOTE = ' 

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("ThisWorkbook")
        Set CodeMod = VBComp.CodeModule

        With CodeMod
            LineNum = .CreateEventProc("Open", "Workbook")
            LineNum = LineNum + 1
            .InsertLines LineNum,  QUOTE 
        End With
    End Sub

Answer 1

首先，请更改

Const QUOTE = '

到此：

Const QUOTE = "'"

基本上你的引用（或Rem）将是一个字符串，需要用引号括起来。

对于 VB Extensibilty ，您可能需要删除找到的行，并在开头插入带有注释的新行。

请参阅Chip Pearson: Programming in the VBA Editor

Answer 2

我已经使用此代码找到了解决问题的方法：

Sub CommentCodeModule(wb As Workbook)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim WordToFind As String
        Dim SL As Long ' start line
        Dim EL As Long ' end line
        Dim SC As Long ' start column
        Dim EC As Long ' end column
        Dim Found As Boolean
        Dim LineNum As Long
        Set VBProj = wb.VBProject
        Set VBComp = VBProj.VBComponents("Module3")
        Set CodeMod = VBComp.CodeModule

        WordToFind = "test"

        With CodeMod
            SL = 1
            EL = .CountOfLines
            SC = 1
            EC = 255
            Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
                EndLine:=EL, EndColumn:=EC, _
                wholeword:=True, MatchCase:=False, patternsearch:=False)
            Do Until Found = False
                Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
                EL = .CountOfLines
                SC = EC + 1
                EC = 255

                Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
                    EndLine:=EL, EndColumn:=EC, _
                    wholeword:=True, MatchCase:=False, patternsearch:=False)
            Loop
             LineNum = SL
             .DeleteLines LineNum

            .InsertLines LineNum, "  ' test"
        End With
    End Sub

感谢所有帮助过我的人。

从另一个VBA代码中注释vba代码

2 个答案: