R
RB Smissaert
This is in Excel 2003.
Using the Microsoft Visual Basic for Applications Extensibility Library 5.3
I am adding lines of code to a procedure.
The procedure is already there, so Sub XXX() and End Sub are there and just
adding lines to the body of the procedure.
Now I am trying to do this without causing a reset, that is without module
level and project level variables being lost and most importantly with a
running userform staying alive. I am not sure this is possible, but if you
do it manually
in the VBE it works OK, but I can't achieve this via the Extensibility
library. When the lines are added all is fine, but when the procedure ends
that adds the lines then the reset happens and the userform will disappear.
Below the code that adds the code lines after clearing any existing lines. I
haven't actually set a reference to the Extensibility library, so the VBE
objects are declared as Object.
Thanks for any advice, but my guess is that this is just not possible.
Sub InsertProcedureLines(strProject As String, _
strModule As String, _
strProcedure As String, _
arrCodeLines As Variant, _
Optional bFunction As Boolean)
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcFirstLine As Long
ClearProcedureBody strProject, _
strModule, _
strProcedure, _
bFunction
lProcFirstLine = GetProcedureFirstLine(strProject, _
strModule, _
strProcedure)
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
For i = 0 To UBound(arrCodeLines)
oCodeModule.InsertLines lProcFirstLine + 1 + i, arrCodeLines(i)
Next i
End Sub
Sub ClearProcedureBody(strProject As String, _
strModule As String, _
strProcedure As String, _
Optional bFunction As Boolean)
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcFirstLine As Long
Dim lProcLastLine As Long
lProcFirstLine = GetProcedureFirstLine(strProject, _
strModule, _
strProcedure)
lProcLastLine = GetProcedureLastLine(strProject, _
strModule, _
strProcedure, _
bFunction)
'no lines between procedure start and end
If lProcLastLine - lProcFirstLine < 2 Then Exit Sub
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
oCodeModule.DeleteLines lProcFirstLine + 1, (lProcLastLine -
lProcFirstLine) - 1
End Sub
Function GetProcedureFirstLine(strProject As String, _
strModule As String, _
strProcedure As String) As Long
Dim oProject As Object
Dim oCodeModule As Object
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
GetProcedureFirstLine = oCodeModule.ProcBodyLine(strProcedure, 0)
End Function
Function GetProcedureLastLine(strProject As String, _
strModule As String, _
strProcedure As String, _
Optional bFunction As Boolean) As Long
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcStartLine As Long
Dim lProcBodyStartLine As Long
Dim lProcCountLines As Long
Dim strProcEnd As String
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
'includes blank lines before the procedure start
lProcStartLine = oCodeModule.ProcStartLine(strProcedure, 0)
'Line where actual Sub or Function starts
lProcBodyStartLine = oCodeModule.ProcBodyLine(strProcedure, 0)
'number of lines from lProcStartLine to end,
'including blank lines after End Sub or End Function
lProcCountLines = oCodeModule.ProcCountLines(strProcedure, 0)
If bFunction Then
strProcEnd = "End Function"
Else
strProcEnd = "End Sub"
End If
For i = lProcBodyStartLine + 1 To lProcStartLine + lProcCountLines - 1
If oCodeModule.Find(Target:=strProcEnd, _
StartLine:=i, StartColumn:=1, _
EndLine:=i, EndColumn:=255, _
WholeWord:=True, MatchCase:=True, _
PatternSearch:=False) Then
GetProcedureLastLine = i
Exit For
End If
Next i
End Function
RBS
Using the Microsoft Visual Basic for Applications Extensibility Library 5.3
I am adding lines of code to a procedure.
The procedure is already there, so Sub XXX() and End Sub are there and just
adding lines to the body of the procedure.
Now I am trying to do this without causing a reset, that is without module
level and project level variables being lost and most importantly with a
running userform staying alive. I am not sure this is possible, but if you
do it manually
in the VBE it works OK, but I can't achieve this via the Extensibility
library. When the lines are added all is fine, but when the procedure ends
that adds the lines then the reset happens and the userform will disappear.
Below the code that adds the code lines after clearing any existing lines. I
haven't actually set a reference to the Extensibility library, so the VBE
objects are declared as Object.
Thanks for any advice, but my guess is that this is just not possible.
Sub InsertProcedureLines(strProject As String, _
strModule As String, _
strProcedure As String, _
arrCodeLines As Variant, _
Optional bFunction As Boolean)
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcFirstLine As Long
ClearProcedureBody strProject, _
strModule, _
strProcedure, _
bFunction
lProcFirstLine = GetProcedureFirstLine(strProject, _
strModule, _
strProcedure)
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
For i = 0 To UBound(arrCodeLines)
oCodeModule.InsertLines lProcFirstLine + 1 + i, arrCodeLines(i)
Next i
End Sub
Sub ClearProcedureBody(strProject As String, _
strModule As String, _
strProcedure As String, _
Optional bFunction As Boolean)
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcFirstLine As Long
Dim lProcLastLine As Long
lProcFirstLine = GetProcedureFirstLine(strProject, _
strModule, _
strProcedure)
lProcLastLine = GetProcedureLastLine(strProject, _
strModule, _
strProcedure, _
bFunction)
'no lines between procedure start and end
If lProcLastLine - lProcFirstLine < 2 Then Exit Sub
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
oCodeModule.DeleteLines lProcFirstLine + 1, (lProcLastLine -
lProcFirstLine) - 1
End Sub
Function GetProcedureFirstLine(strProject As String, _
strModule As String, _
strProcedure As String) As Long
Dim oProject As Object
Dim oCodeModule As Object
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
GetProcedureFirstLine = oCodeModule.ProcBodyLine(strProcedure, 0)
End Function
Function GetProcedureLastLine(strProject As String, _
strModule As String, _
strProcedure As String, _
Optional bFunction As Boolean) As Long
Dim i As Long
Dim oProject As Object
Dim oCodeModule As Object
Dim lProcStartLine As Long
Dim lProcBodyStartLine As Long
Dim lProcCountLines As Long
Dim strProcEnd As String
Set oProject = Application.Workbooks(strProject).VBProject
Set oCodeModule = oProject.VBComponents(strModule).CodeModule
'includes blank lines before the procedure start
lProcStartLine = oCodeModule.ProcStartLine(strProcedure, 0)
'Line where actual Sub or Function starts
lProcBodyStartLine = oCodeModule.ProcBodyLine(strProcedure, 0)
'number of lines from lProcStartLine to end,
'including blank lines after End Sub or End Function
lProcCountLines = oCodeModule.ProcCountLines(strProcedure, 0)
If bFunction Then
strProcEnd = "End Function"
Else
strProcEnd = "End Sub"
End If
For i = lProcBodyStartLine + 1 To lProcStartLine + lProcCountLines - 1
If oCodeModule.Find(Target:=strProcEnd, _
StartLine:=i, StartColumn:=1, _
EndLine:=i, EndColumn:=255, _
WholeWord:=True, MatchCase:=True, _
PatternSearch:=False) Then
GetProcedureLastLine = i
Exit For
End If
Next i
End Function
RBS