使用 VBA 在“ThisWorkbook”中的 Excel 工作簿中插入代码答案

【问题标题】：Insert code in Excel workbook in "ThisWorkbook" using VBA使用 VBA 在“ThisWorkbook”中的 Excel 工作簿中插入代码
【发布时间】：2017-08-25 04:39:44
【问题描述】：

在使用 VBA 将相当大的代码插入 Excel 中的“ThisWorkbook”模块时，我需要帮助。

使用下面的代码，我可以将代码插入到“ThisWorkbook”模块中，但是这种方法（正如我最近了解到的）由于线喙（&_）而有 24 行的限制。

Sub AddCode()
Dim VBP As Object
Dim newmod As Object
Set VBP = ActiveWorkbook.VBProject
Set newmod = VBP.VBComponents.Add(1)
Dim StartLine As Long
Dim cLines As Long

With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
cLines = .CountOfLines + 1
    .InsertLines cLines, _
        "Private Sub Workbook_Open()" & Chr(13) & _
                "   Application.Calculation = xlManual" & Chr(13) & _
                "   Application.CalculateBeforeSave = False" & Chr(13) & _
                "   Application.DisplayFormulaBar = False" & Chr(13) & _
        "Call Module1.ProtectAll" & Chr(13) & _
        "End Sub"
End With 
End Sub

除了上面的代码之外，我想注入的代码如下（在另一个站点上找到的代码）。这使我可以跟踪与他人共享的工作簿的更改。我不想使用 Excel 的内置“跟踪更改”功能。

Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean

If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
    End With
    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheet1
            .Unprotect Password:="Passcode"
                If .Range("A1") = vbNullString Then
                    .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
                        "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
                End If
            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = Target.Address
                  .Offset(0, 1) = vOldVal
                      With .Offset(0, 2)
                        If bBold = True Then
                          .ClearComments
                          .AddComment.Text Text:= _
                               "Note:" & Chr(10) & "" & Chr(10) & _
                                  "Bold values are the results of formulas"
                        End If
                          .Value = Target
                          .Font.Bold = bBold
                      End With               
                .Offset(0, 3) = Time
                .Offset(0, 4) = Date
            End With
            .Cells.Columns.AutoFit
            .Protect Password:="Passcode"
        End With
    vOldVal = vbNullString
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    vOldVal = Target
End Sub

我怎样才能做到这一点？最好和最有效的方法是什么？

我尝试将代码分成 20 行的块并创建 3 个“AddCode”子例程，但在“bBold = Target.HasFormula”处出现错误。我在网上搜索了替代品，但似乎没有任何效果。

提前致谢。

【问题讨论】：

将代码粘贴到工作表单元格中并从那里读取。或来自文本文件。
如果您不关心可读性，您可以在 Chr(13) 之后跳过换行符 (& _)。结果是一样的。
感谢蒂姆和阿奇姆。
感谢蒂姆和阿奇姆。蒂姆，从单元格或文本中读取可能不可行，因为我将其发送给客户并且不希望他们知道正在记录更改。 Sheet1（发生日志记录的地方）是 xlVeryHidden。我实际上将一张工作表从一个工作簿复制到另一个工作簿，当时我想将代码插入到新工作簿的 ThisWorkbook 中。 Achim，如果没有其他选择，那么我将不得不摆脱换行符并继续使用它，尽管我想保持可读性；我也试过 vbNewLine 也没有用。

标签： vba excel

【解决方案1】：

这是我在加载代码时所做的工作的简化版本。我创建了 onload 事件，然后添加了一个新模块。

Sub AddOnload()
''Create on load sub
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
   .InsertLines 1, "Private Sub Workbook_Open()"
   .InsertLines 2, "   call CallMe"
   .InsertLines 3, "End Sub"
End With
Call CreateCode
End Sub

''Add new module with code
Sub CreateCode()
    Dim vbp As VBProject
    Dim vbc As VBComponent
    Dim strCode
    Set vbp = Application.VBE.ActiveVBProject
    Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
    vbc.Name = "tracker"
    strCode = "Sub CallMe()" & vbCrLf & "End Sub"
    vbc.CodeModule.AddFromString strCode  
End Sub

【讨论】：