Any posibility to modify the sub and function bodies created via VBA IDE - excel

I am willing to add some code to the begining and end of each sub or function for enabling flow tracing / debugging.
Now I copy this (almost standard code manually into the beginig of each sub / function, and also before each exit sub/function and end sub / function statement.
Something like this
public sub a()
...
**logging_successful = pushCallIntoStack("sub a")**
...
On Error Goto errorOccured
...
**logging_successful = popCallFromStack("sub a")**
Exit Sub
...
errorOccured:
...
**logging_successful = popCallFromStack("sub a")**
...
End Sub
Being able to insert these standart codes via VBIDE as default - at least in the standard entry and exit points - will save me sometime.

What you want to do is technically doable but are you sure you want to add boilerplate code with hard-coded strings to all of your procedures? That is lot of maintenance which also makes it much harder to refactor your code. I've seen lot of error messages saying it came from "Foo" but they came from "Bar" because at one point the code was in Foo but then it got moved or renamed to Bar, but they forgot to update the string constant. There is no such guarantees that the string constants are in sync with the actual procedure names.
Before sinking potentially hours into this solution, I would encourage you to first consider third-party addins that can do a much better job of helping you getting the detailed error output you need. One such solution would be vbWatchDog which provides you not only the stack tracing but also much extended diagnostics... without any changes to your source code. Precisely because it can do without any embedding constants, it won't be liable to give you outdated information.
I should note that there are also other third-party addin such as MZ-Tools which provides a one click button for adding an error template that could conceivably be used to provide what you want. However, the operation is not reversible, which adds to your maintenance burden; changing a procedure would mean you'd have to strip away the old error template, then re-add, and if there's any customization, to re-add it.
If in spite of all, you insist on continuing doing it by your own hand, you can do something like the following:
Public Sub AddBoilerPlate(TargetComponent As VBIDE.VBComponent)
Dim m As VBIDE.CodeModule
Dim i As Long
Set m = TargetComponent.CodeModule
For i = m.CountOfDeclarationLines + 1 To m.CountOfLines
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
ProcName = m.ProcOfLine(i, ProcKind)
Dim s As Long
s = m.ProcBodyLine(ProcName, ProcKind) + 1
m.InsertLines s, <your push code>
'Loop the lines within the procedure to find the End *** line then insert the pop code
Next
End Sub
This is an incomplete sample, does not perform checks for pre-existing template. A more complete sample would probably delete any previous template before inserting.

You may need to amend the codes for your own needs but below's the general idea (e.g. change "Module2" to the name of your module and include more checks to determine where to add in new codes)
Public Sub sub_test()
Dim i As Long
With ThisWorkbook.VBProject.VBComponents("Module2").CodeModule
For i = 1 To .Countoflines
If InStr(.Lines(i, 1), "End Sub") > 0 Then
.Insertlines i, "**logging_successful = popCallFromStack(""sub a"")**"
End If
Next i
End With
End Sub

Related

EXCEL VBA Type mismatch with "Next" highlighted

I'm creating small project in Excel, and because I'm a VBA newbie I do encounter a lot of problems that I'm trying to resolve on my own. However i can't cope with this:
I created Sub that accepts two objects: FormName and ControlName.
What i want it to do, is to loop through every Control in specific UserForm and populate every ListBox it encounters, from another ListBox.
I created this funny string comparison, because I need to operate on objects in order to execute the line with AddItem. This comparison actually works well, no matter how ridiculous it is. However when I launch the program, I got
Type Mismatch error
and to my surprise "Next" is being highlighted. I have no idea how to fix this, nor what is wrong.
Public Sub deploy(ByRef FormName As Object, ByRef ControlName As Object)
Dim i As Integer
Dim O As msforms.ListBox
i = 0
For Each O In FormName.Controls
If Left(FormName.Name & O.Name, 16) = Left(FormName.Name & ControlName.Name, 16) Then
O.AddItem (FormName.PodglÄ…d.List(i))
i = i + 1
End If
Next
End Sub
I call this sub using:
Call deploy(UserForm1, UserForm1.ListBox3)
Above, I use Listbox3 because otherwise i got error saying that variable is not defined. However in my comparison I kinda override this.
If someone can explain in simple words, how to fix this type mismatch issue or how to write it in more elegant way

BackUp+Restore IDE bookmarks at a specific line of code

Well, the title is because I had a hard time walking through some unbearable docs and finding what I was looking for so, if these keywords can help for other google searches...
Then, when quitting Excel, all previously marked lines of code are lost and it is very frustrating when you have to go to sleep or Excel crashes :)
So, in a moment of pure madness I thought it could be possible, and even not too hard, to just save those line bookmarks and restore them at start up...
You will tell me there are other choices: don't sleep.. or use some powerful add-ins like MZ-Tools or Rubberduck, but I would like to have a native solution and understand what the problem is.
To cut to the edge, here is the core of my problem:
'sub to move cursor to a selected line and add a line bookmark:
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Application.VBE.VBProjects("VBAProject") _
.VBComponents(CompName).CodeModule.CodePane _
.SetSelection numLine, 1, numLine, 1
Application.VBE.CommandBars("Edit").Controls(18).Controls(1).Execute 'the only way I could find it to work
End Sub
What happens:
1) with only one call it works!
Public Sub test_addBmk()
Call AddBmkOnly("module 1", 10)
End Sub
2) once there are more, or in a loop for example:
Public Sub test_addBmk()
Call AddBmkOnly("module 1", 10) 'cursor is just moved to selected line
Call AddBmkOnly("module 2", 5) 'line bookmark is added only in the last opened/activated/selected/visible/shown/focused on..? codepane
'...
End Sub
Place your cursor inside the 2nd test_addBmk, run and you will see a beautiful cyan blue mark appearing in the margin of your "module 2" at line 5 but that's all, no where else.
I well tried to add this kind of lines in AddBmkOnly to keep focus/active state, but it has no effect:
With Application.VBE.VBProjects("VBAProject").VBComponents(CompName)
.Activate
.CodeModule.CodePane.Window.SetFocus
.CodeModule.VBE.ActiveCodePane.Show
'...?
end with
I tried adding some DoEvents, Debug.Print, loop to 1M or likes to see if it was due to some latency/refreshing effect, but no effect either.
It could have something to do with the active state of the module or codepane window, but I can't find a working combination (also, closing the last pane - .ActiveCodePane.Window.Close - will avoid a bookmark to be added too).
It seems also that the focus is lost before an anchor is added, whatever I try, or the 'add bookmark' menu action doesn't see where to apply.... or it is something else...
Calling test_addBmk() multiple times doesn't work neither, the only way I found is creating 'one action' buttons in an Excel sheet, as many as the number of bookmarks I needed... that's not funny.
What am I doing wrong? Is it even possible the way I'm trying? How can I add more than a single bookmark?
You need to active the code pane before you invoke the menu item:
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Dim editor As VBE
Dim project As VBProject
Dim component As VBComponent
Set editor = Application.VBE
Set project = Application.VBE.VBProjects("VBAProject")
Set component = project.VBComponents(CompName)
component.CodeModule.CodePane.SetSelection numLine, 1, numLine, 1
component.Activate
Application.VBE.CommandBars("Edit").Controls("&Toggle Bookmark").Execute 'the only way I could find it to work... almost[*]
End Sub
Note that this won't work if you try to step through it in a debugger, because each time you step it sets the active pane back to the code that you're executing.
A couple other notes:
You should be testing the number of code lines before trying to set the selection - if numLine is higher than the lines of code in the module, that's an application error.
Call should be considered deprecated - there's absolutely no reason to use it.
You should avoid hard coding an index in the Controls collection - other add-ins can modify these, so who knows what you'll get.
Thanks for mentioning Rubberduck! (I'm a contributor)
This version of the above works for me.
Public Sub test_addBmk()
Call AddBmkOnly("module1", 10)
Call AddBmkOnly("module2", 5)
End Sub
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Dim editor As VBE
Dim project As VBProject
Dim component As VBComponent
Set editor = Application.VBE
Set project = Application.VBE.VBProjects("VBAProject")
Set component = project.VBComponents(CompName)
component.CodeModule.CodePane.SetSelection numLine, 1, numLine, 1
component.Activate: DoEvents
editor.CommandBars("Edit").Controls("&Toggle Bookmark").Execute
DoEvents
End Sub

Adding a layer of abstraction to UserFrom - am I doing it right?

I'd like to create a UserForm showing a progress of some operation (let's call it ProgressForm). I'd also like to make this form simple to reuse in multiple Workbooks by me and other coworkers. Finally, I'd like to make my ProgressForm as fool-proof as possible.
To make my form simple to use I've decided to create 3 "methods":
P_Begin(Goal) - to set up a goal and prepare form
P_Step() - to record a progress and update form
P_End() - to dispose a form
Now, to make it fool-proof I need some "system" that prevents using P_Step or P_End before P_Begin is called (as we need to set our goal FIRST before we try to make any progress).
My idea is to use a flag (let's call it "IsCreated") that will tell whether or not P_Begin was called. Here's what I've got so far:
Private IsCreated As Boolean
Private Goal As UInteger
Private Progress As UInteger
Function P_Begin(pGoal As UInteger)
If IsCreated Then
Err.Raise 5
End If
Goal = pGoal
Progress = 0
IsCreated = True
' Prepare ProgressForm elements here
Me.Show vbModeless
End Function
Function P_Step()
If Not IsCreated Then
Err.Raise 5
End If
Progress = Progress + 1
' Update ProgressForm elements here
End Function
Function P_End()
If Not IsCreated Then
Err.Raise 5
End If
IsCreated = False
Me.Hide
End Function
This is how I imagine sample use:
Sub DoingSomething()
ProgressForm.P_Begin pGoal:=100
For i = 1 To 100
' Doing Something
ProgressForm.P_Step
Next i
ProgressForm.P_End
ProgressForm.P_Begin pGoal:=200
For i = 1 To 200
'Doing Something Else
ProgressForm.P_Step
Next i
ProgressForm.P_End
' and so on...
End Sub
Looks pretty nice, right? Well, there's a "little" problem: IsCreated variable is not initialized when P_Begin is first called so my code is unreliable. I have some ideas how to deal with it, but none of them satisfies me:
Making IsCreated Public and setting it to False in Workbook_Open Sub - I don't like it as it makes ProgressForm less simple to use - Form user would have to remember to set IsCreated to False in every workbook that uses ProgressForm. Also: abstraction.
Dropping fool-proof requirement by not using IsCreated flag at all.
Rely on a fact that uninitialized Boolean is by default set to False, so IsCreated is conveniently set to False by default - it's just wrong, very, very wrong.
Somehow pushing IsCreated initialization to ProgressForm_Initialize() method. However, in order to show my form I first need to call P_Begin to set a goal. But P_Begin relies on IsCreated variable... Oops, circular dependency.
Somehow wrapping ProgressForm in class? It's just my guess, I must admit: I don't know how OOP works in VBA.
Somehow counting ProgressForms and setting IsCreated to false in the first one? Sounds a bit messy. Once again: it's just my wild guess based on this post, which I don't understand entirely...
Usually when I encounter a problem with apparently no solution, it usually means that my idea is fundamentally incorrect. Maybe there is better, VBA-way to achieve desired results?
Change as follows (possible solution):
Private IsCreated As Integer
...
IsCreated = 99 ' in P_Begin
...
If (IsCreated <> 99) then ' raise error
...
IsCreated = 0 ' in P_End
This relies on the fact that VB will [probably] never initialize an integer variable to 99.

How do you GoTo a line label in a different object?

E.g. Given Sheet 1 contains:
Ref: Do things
How can I direct a code in Module 1 to GoTo Ref? If I were in the Sheet1 code moduke then I could simply use a
Goto Ref
But this doesn't work across different modules
Your question is not clear and you didn't provide any code, so this is a guess.
GoTo is used to jump to different locations within the same sub/function. You cannot use it to jump to parts of other sub routines or functions, which it sounds like you might be trying to do.
Also, "NapDone:" is not called a reference, it's formally called a line label. :)
To help expand on the other answers.. Like they said you shouldn't use GoTo for anything in VBA except error handling.
What you should be doing is calling a public sub/function from another module. For example in Module 1 you would have the following
Sub TestMod1()
Dim MyNumber As Integer
MyNumber = GetSquare(6)
'MyNumber returns from the function with a value of 36
End Sub
and on Module 2 you have
Public Function GetSquare(ByVal MyNumber As Integer)
GetSquare = MyNumber * MyNumber
End Function
So now you know how to avoid it. GoTo is not very good programming practice as you'll have things flying all over the place. Try to break down code you're repeating into multiple Subs and just call them when needed, or functions whatever be the case. Then you'll get into classes, which are just wrapped up to represent an object and it'll do all the work for that object.
This should get you on the right track.

Stop VBA Evaluate from calling target function twice

I am having trouble getting VBA's Evaluate() function to only execute once; it seems to always run twice. For instance, consider the trivial example below. If we run the RunEval() subroutine, it will call the EvalTest() function twice. This can be seen by the two different random numbers that get printed in the immediate window. The behavior would be the same if we were calling another subroutine with Evaluate instead of a function. Can someone explain how I can get Evaluate to execute the target function once instead of twice? Thank you.
Sub RunEval()
Evaluate "EvalTest()"
End Sub
Public Function EvalTest()
Debug.Print Rnd()
End Function
This bug only seems to happen with UDFs, not with built-in functions.
You can bypass it by adding an expression:
Sub RunEval()
ActiveSheet.Evaluate "0+EvalTest()"
End Sub
But there are also a number of other limitations with Evaluate, documented here
http://www.decisionmodels.com/calcsecretsh.htm
I don't know of a way to stop it, but you can at least recognize when it is happening most of the time. That could be useful if your computation is time consuming or has side effects that you don't want to have happen twice and you want to short circuit it.
(EDIT: Charles Williams actually has an answer to your specific quesion. My answer could still be useful when you don't know what data type you might be getting back, or when you expect to get something like an array or a range.)
If you use the Application.Caller property within a routine called as a result of a call to Application.Evaluate, you'll see that one of the calls appears to come from the upper left cell of of the actual range the Evaluate call is made from, and one from cell $A$1 of the sheet that range is on. If you call Application.Evaluate from the immediate window, like you would call your example Sub, one call appears to come from the upper left cell of the currently selected range and one from cell $A$1 of the current worksheet. I'm pretty sure it's the first call that's the $A$1 in both cases. (I'd test that if it matters.)
However, only one value will ever be returned from Application.Evaluate. I'm pretty sure it's the one from the second eval. (I'd test that too.)
Obviously, this won't work with calls made from the actual cell $A$1.
(As for me, I would love to know why the double evaluation happens. I would also love to know why the evaluator is exposed at all. Anyone?)
EDIT: I asked on StackOverflow here: Why is Excel's 'Evaluate' method a general expression evaluator?
I hope this helps, although it doesn't directly answer your question.
I did a quick search and found that others have reported similar behavior and other odd bugs with Application.Evaluate (see KB823604 and this). This is probably not high on Microsoft's list to fix since it has been seen at least since Excel 2002. That knowledge base article gives a workaround that may work in your case too - put the expression to evaluate in a worksheet and then get the value from that, like this:
Sub RunEval()
Dim d As Double
Range("A1").Formula = "=EvalTest()"
d = Range("A1").Value
Range("A1").Clear
Debug.Print d
End Sub
Public Function EvalTest() As Double
Dim d As Double
d = Rnd()
Debug.Print d
EvalTest = d + 1
End Function
I modified your example to also return the random value from the function. This prints the value a second time but with the one added so the second print comes from the first subroutine. You could write a support routine to do this for any expression.
I face the same problem, after investigation i found the function called twice because i have drop down list and the value used in a user defined function.
working around by the code bellow, put the code in ThisWorkbook
Private Sub Workbook_Open()
'set the calculation to manual to stop calculation when dropdownlist updeated and again calculate for the UDF
Application.Calculation = xlCalculationManual
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Source As Range)
'calculte only when the sheet changed
Calculate
End Sub
It looks like Application.Evaluate evaluates always twice, while ActiveSheet.Evaluate evaluates once if it is an expression.
When the object is not specified Evaluate is equivalent to Application.Evaluate.
Typing [expression] is equivalent to Application.Evaluate("expression").
So the solution is to add ActiveSheet and to make that an expression by adding zero:
ActiveSheet.Evaluate("EvalTest+0")
After seeing there is no proper way to work around this problem, I solved it by the following:
Dim RunEval as boolean
Sub RunEval()
RunEval = True
Evaluate "EvalTest()"
End Sub
Public Function EvalTest()
if RunEval = true then
Debug.Print Rnd()
RunEval = False
end if
End Function
problem solved everyone.

Resources