View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert[_2_] RB Smissaert[_2_] is offline
external usenet poster
 
Posts: 37
Default avoid reset after CodeModule InsertLines

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