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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.