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

Question

I need help with inserting a sizeable code into "ThisWorkbook" module in Excel using VBA.

Using the code below I'm able to insert the code into "ThisWorkbook" module, but this method (as I've learned recently) has limitations of 24 lines due to line beak (& _).

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

The code I want to inject in addition to the code above is below (code found on another site). This allows me to track changes on the workbook that I share with others. I do not want to use Excel's built-in "Track Changes" feature.

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

How can I achieve this? What is the best and the most efficient way to do this?

I've tried splitting the code in chunks of 20 lines and create 3 "AddCode" sub-routines, but I get an error at "bBold = Target.HasFormula". I have searched the web for alternatives, but nothing seems to be working.

Thanks in advance.

Answer 1

This is an abbreviated version of what I'm doing to create on load code. I create the onload event, then add a new module.

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