Lets say I have the following:
Public Sub Information()
'TEST
End Sub
Is there a way to get "TEST" as a result?
Somehow through VBA?
E.g. - In PHP there is a good way to take the comments. Any ideas here?
Edit:
There should be a way, because tools like MZ-Tools are able to provide the comments when they generate the documentation.
You need to parse the code yourself, using the VBA Extensibility library (aka "VBIDE API"). Add a reference to the Microsoft Visual Basic for Applications Extentibility 5.3 type library, and then you can access types such as CodePane and VBComponent:
Sub FindComments()
Dim component As VBComponent
For Each component In Application.VBE.ActiveVBProject.VBComponents
Dim contents As String
contents = component.CodeModule.Lines(1, component.CodeModule.CountOfLines)
'"contents" now contains a string with the entire module's code.
Debug.Print ParseComments(contents) 'todo
Next
End Sub
Once you have a module's contents, you need to implement logic to find comments... and that can be tricky - here's some sample code to play with:
Sub Test()
Dim foo 'this is comment 1
'this _
is _
comment 2
Debug.Print "This 'is not a comment'!"
'..and here's comment 3
REM oh and guess what, a REM instruction is also a comment!
Debug.Print foo : REM can show up at the end of a line, given an instruction separator
End Sub
So you need to iterate the lines, track whether the comment is continuing on the next line / continued from the previous line, skip string literals, etc.
Have fun!
After some tests, I got to this solution:
simply pass the name of the code-module to the function and it will print all comment lines. Inline comments won't work(you have to change the condition)
Function findComments(moduleName As String)
Dim varLines() As String
Dim tmp As Variant
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
'split the lines of code into string array
varLines = Split(.lines(1, .CountOfLines), vbCrLf)
End With
'loop through lines in code
For Each tmp In varLines
'if line starts with '
If Trim(tmp) Like "'*" Then
'print comment line
Debug.Print Trim(tmp)
End If
Next tmp
End Function
You can use Microsoft Visual Basic for Applications Extensibility to examine code at runtime:
'Requires reference to Microsoft Visual Basic for Applications Extensibility
'and trusted access to VBA project object model.
Public Sub Information()
'TEST
End Sub
Public Sub Example()
Dim module As CodeModule
Set module = Application.VBE.ActiveVBProject.VBComponents(Me.CodeName).CodeModule
Dim code As String
code = module.lines(module.ProcStartLine("Information", vbext_pk_Proc), _
module.ProcCountLines("Information", vbext_pk_Proc))
Dim lines() As String
lines = Split(code, vbCrLf)
Dim line As Variant
For Each line In lines
If Left$(Trim$(line), 1) = "'" Then
Debug.Print "Found comment: " & line
End If
Next
End Sub
Note that the above example assumes that it's running in a Worksheet or Workbook code module (hence Me when locating the CodeModule). The best method for locating the correct module will depend on where you want to locate the procedure.
You could try with reading line by line of code in your module. Here is just idea returning first comment for further improvements:
Sub callIt()
Debug.Print GetComment("Module1")
End Sub
Function GetComment(moduleName As String)
Dim i As Integer
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
For i = 1 To .CountOfLines
If Left(Trim(.Lines(i, 1)), 1) = "'" Then
'here we have comments
'return the first one
GetComment = .Lines(i, 1)
Exit Function
End If
Next i
End With
End Function
Important! in Reference window add one to 'Microsoft Visual Basic for Applications Extensibility'.
Related
I want to get a list of routines from a VBA project, then run the macros selected by the user.
The image below shows the native "Macros" box. I want to extend this functionality to multiple macros across multiple documents.
I found this link which solves the first part of the problem. Now that I have my list, how do I run a selected routine by name?
Hello and welcome to SO
Below is code sample how to execute VBA macro using code. You need to add some form to select documents and macros for execute. This depends on your implementation.
Sub RunMacroUsingCode()
Dim vbaProjectName As String
vbaProjectName = "InventorVBA"
Dim vbaModuleName As String
vbaModuleName = "m_Tests"
Dim vbaMacroName As String
vbaMacroName = "RunMultipleMacrosTestCall"
Dim vbaProject As InventorVBAProject
For Each vbaProject In ThisApplication.VBAProjects
If vbaProject.name = vbaProjectName Then Exit For
Next
Dim vbaModule As InventorVBAComponent
For Each vbaModule In vbaProject.InventorVBAComponents
If vbaModule.name = vbaModuleName Then Exit For
Next
'Using result is optional
Dim result As Variant
Call vbaModule.InventorVBAMembers(vbaMacroName).Execute(result)
End Sub
Function RunMultipleMacrosTestCall()
Call MsgBox("TEST")
RunMultipleMacrosTestCall = True
End Function
I'd like to use the .DeleteLinesfunction in VBA. As I'm not deleting all the lines in the module i need a targeted approach. I assume there is a function like Find("FooBar").LineNumber, however I can't find it here/with google:
https://msdn.microsoft.com/en-us/library/office/gg264546.aspx
Sub Deletings()
With Workbooks("ClassExperiment.xlsm").VBProject.VBComponents("Module2").CodeModule
.DeleteLines(HowDoIGetThisValue, 0)
End With
End Sub
Help appreciated.
If you're removing the entire procedure, you can find its location with the ProcStartLine property and the line count with ProcCountLines.
Dim module As CodeModule
Set module = Workbooks("ClassExperiment.xlsm").VBProject.VBComponents("Module2").CodeModule
Dim start As Long
Dim lines As Long
With module
start = .ProcStartLine("button_Click", vbext_pk_Proc)
lines = .ProcCountLines("button_Click", vbext_pk_Proc)
.DeleteLines start, lines
End With
Warning:
This should be obvious, but I'll throw it out there anyway. Do not use this (or any other method) to alter the module that the code is running from in Debug mode. This is a good way to break your workbook.
Sub test()
Dim vb As VBComponent
Dim i As Integer
Set vb = ThisWorkbook.VBProject.VBComponents("Module2")
For i =vb.CodeModule.CountOfLines to 1 step -1
If InStr(1, vb.CodeModule.Lines(i, 1), "' remove") <> 0 Then
vb.CodeModule.DeleteLines i, 1
End If
Next i
End Sub
I would of also suggested using a condition statement to allow execution of the code line, rather than deleting it, when is it put back? this could cause issues if you wish to automate that bit, as you'll need to know where it came from.
I am looking to create some metrics about the quality of the VBA code I am writing, through different ratios of the actual code written and comment lines written.
Ideally I am looking for a VBA script/function to detect the comment lines in Macro Enabled workbooks and Excel add-ins and being able to differentiate where the comments and code are written e.g. have the comment to code ratio for each module and form in a project.
Below is the code I have so far, but I only managed to found how to give the total count of the lines and the count for the declaration lines. Is there something similar for comments?
Public Sub moduleInfo()
Dim objModule As Object
For Each objModule In Application.VBE.ActiveVBProject.VBComponents
With objModule
Debug.Print .Name, .CodeModule.CountOfLines, .CodeModule.CountOfDeclarationLines
End With
Next objModule
End Sub
You can check the existence of the character ' to spot a comment line. The comment ,ight occur anywhere in the code, such as after the instruction (you can easily modify the code if you want to count only lines that are purely comments). You can also count blank lines, because the CountOfLines property includes these.
Public Sub moduleInfo()
Dim comp As VBComponent, m As CodeModule
Debug.Print "Module", , "Lines", "Declarations", "Blanks", "Comments"
For Each comp In Application.VBE.ActiveVBProject.VBComponents
Set m = comp.CodeModule
Dim comments As Integer, blanks As Integer, i As Integer, line As String
For i = 1 To m.CountOfLines
line = Trim(m.Lines(i, 1))
If Len(line) = 0 Then
blanks = blanks + 1
ElseIf InStr(line, Chr(39)) Then
comments = comments + 1
End If
Next
Debug.Print m.Name, , m.CountOfLines, m.CountOfDeclarationLines, blanks, comments
Next
End Sub
I cannot figure out why my excel workbook file keeps on crashing everytime I open the file.
I have this event handler which I'm sure the one causing the problem.
Option Explicit
Private Sub Workbook_Open()
On Error Resume Next
CurrEntities = Array("Curr1,Ent1", "Curr2,Ent2", "Curr3,Ent3")
End Sub
CurrEntities is declared as public in separate Module.
Public CurrEntities() As Variant
When I try to comment out the line - CurrEntities = Array("Curr1,Ent1", "Curr2,Ent2", "Curr3,Ent3"), the file can be opened without a problem.
So strange because it doesn't give any run time error, it will just prompt a message "Microsoft Excel has stopped working" and then the Excel closes.
Is there something I missed or violated an array variable declaration?
Public CurrEntities() As Variant
means: declare an array of Variant.
Replace with:
Public CurrEntities As Variant
and everything should be OK ;)
Unless... you want to use an array:
Public CurrEntities() As Variant
Sub Test()
Dim i As Integer, j As Integer
Dim curent As Variant
CurrEntities = Array(Array("a", "b"), Array("c", "d"))
For i = LBound(CurrEntities()) To UBound(CurrEntities)
curent = CurrEntities(i)
Debug.Print "---=== " & i & " ===---"
For j = LBound(curent) To UBound(curent)
Debug.Print curent(j)
Next
Next
End Sub
Cheers,Maciej
The declaration above and the usage has no problem. I found out and rectified the problem when I tried to create another file and use only the necessary variable for testing. The problem was caused by another variable which is declared incorrectly:
Public CoCodes("00123", "00456", "00789") As String
I removed this line from my code and the above code worked perfectly.
I have an Excel .xlam file that adds a button in the ribbon to do the following:
Scan the ActiveSheet for some pre-set parameters
Take my source text (a string value, hard coded directly in a VBA Module) and replace designated areas with the parameters retrieved from step 1
Generate a file containing the calculated text
I save the source text this way because it can be password protected and I don't need to drag another file around everywhere that the .xlam file goes. The source text is saved in a separate module called "Source" that looks something like this (Thanks VBA for not having Heredocs):
'Source Module
Public Function GetSource() As String
Dim s As String
s = ""
s = s & "This is the first line of my source text" & vbCrLf
s = s & "This is a parameter {par1}" & vbCrLf
s = s & "This is another line" & vbCrLf
GetSource = s
End Function
The function works fine. My problem is if I want to update the source text, I now have to manually do that in the .xlam file. What I would like to do is build something like a Sub ImportSource() in another module that will parse some file, rebuild the "Source" Module programatically, then replace that Module with my calculated source code. What I don't know is if/how to replace the source code of a module with some value in a string variable.
It's like metaprogramming at its very worst and philosophically I'm against doing this down to my very core. Practically, however, I would like to know if and how to do it.
I realize now that what you really want to do is store some values in your document in a way that is accessible to your VBA, but that is not readable to a user of the spreadsheet. Following Charles Williams's suggestion to store the value in a named range in a worksheet, and addressing your concern that you don't want the user to have access to the values, you would have to encrypt the string...
The "proper way" to do this is described in this article - but it's quite a bit of work.
A much shorter routine is found here. It just uses simple XOR encryption with a hard coded key - but it should be enough for "most purposes". The key would be "hidden" in your macro, and therefore not accessible to prying eyes (well, not easily).
Now you can use this function, let's call it encrypt(string), to convert your string to a value in the spreadsheet:
range("mySecretCell").value = encrypt("The lazy dog jumped over the fox")
and when you need to use it, you use
Public Function GetSource()
GetSource = decrypt(Range("mySecretCell").value)
End Function
If you use the XOR version (second link), encrypt and decrypt would be the same function...
Does that meet your needs better?
As #brettdj already pointed out with his link to cpearson.com/excel/vbe.aspx , you can programmatically change to code of a VBA module using the VBA Extensibility library! To use it, select the library in the VBA editor Tools->References. Note that you need to also change the options in your Trust center and select: Excel Options->Trust Center->Trust Center Settings->Macro Settings->Trust access to the VBA project object model
Then something like the following code should do the job:
Private mCodeMod As VBIDE.CodeModule
Sub UpdateModule()
Const cStrModuleName As String = "Source"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Workbooks("___YourWorkbook__").VBProject
'Delete the module
VBProj.VBComponents.Remove VBProj.VBComponents(cStrModuleName)
'Add module
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = cStrModuleName
Set mCodeMod = VBComp.CodeModule
'Add procedure header and start
InsertLine "Public Function GetSource() As String"
InsertLine "Dim s As String", 1
InsertLine ""
'Add text
InsertText ThisWorkbook.Worksheets("Sourcetext") _
.Range("___YourRange___")
'Finalize procedure
InsertLine "GetSource = s", 1
InsertLine "End Function"
End Sub
Private Sub InsertLine(strLine As String, _
Optional IndentationLevel As Integer = 0)
mCodeMod.InsertLines _
mCodeMod.CountOfLines + 1, _
Space(IndentationLevel * 4) & strLine
End Sub
Private Sub InsertText(rngSource As Range)
Dim rng As Range
Dim strCell As String, strText As String
Dim i As Integer
Const cLineLength = 60
For Each rng In rngSource.Cells
strCell = rng.Value
For i = 0 To Len(strCell) \ cLineLength
strText = Mid(strCell, i * cLineLength, cLineLength)
strText = Replace(strText, """", """""")
InsertLine "s = s & """ & strText & """", 1
Next i
Next rng
End Sub
You can "export" and "import" .bas files programmatically. To do what you are asking, that would have to be the approach. I don't believe it's possible to modify the code in memory. See this article