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
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
I have a question: i want to have an array of words of a WORD document, which are larger than 29 and Shorter than 40 characters. I implemented it in VBA this way:
Sub function()
Dim arr(1000) As String
counter = 0
For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
If Len(w) > 28 And Len(w) < 40 Then
arr(counter) = w
counter = counter + 1
End If
Next
Next
End Sub
The Problem is that I want all words with char '_' cosidered as one word; for example: 'Adrian_link_mart' is one word and not 3: 'Adrian' and 'link' and 'mart' like it will be considered
thanks for your help, adrian
This may help. There is a bit of a wrinkle as you will see below.
Option explicit
Sub test()
' Use a collection rather than an array as we don't need
' to know the size in advance
Dim word_array As Collection
' Word doesn't actually have a 'word' object. Probably because
' that clashes with Word the application. So instead of Word.Word
' we are using word.range which gives us all the utility we will
' need
Dim my_word_range As Word.Range
Dim my_range As Word.Range
For Each my_range In ActiveDocument.StoryRanges
For Each my_word_range In my_range.Words
With my_word_range
Do While .Next(unit:=wdCharacter) = "_"
' '_' is considered to be a word by Word so we need to
' count two Word words to get to the end of the next
' text word IYSWIM
.MoveEnd unit:=wdWord, Count:=2
Loop
If .Characters.Count > 28 And .Characters.Count < 40 Then
word_array.Add Item:=.Text
End If
End With
Next
Next
End Sub
If you are new to VBA then
Include Option explicit at the top of every module
In the VBA IDE go Tools.Option.Editor.Code Settings and make sure every box is ticked.
Learn how to use F1. In the VBA IDE, putting the cursor on a keyword and pressing F1 will bring up the MS help page for that keyword
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'.
I'm just a beginner for VBA but advance in MS excel. that's why I am very much interested to learn VBA.
ok this is my first question here
Actully i need to format excel sheet where file name is = sheet1 name and it is somewhere in column "A" so I want to select & delete all the rows above this cell & below untill there is a blank cell/row.
I have tried much with InStr & find function but no succeed. Also try to find cell address like B5 but could no do that.
Welcome to StackOverflow. As you have already been informed by newguy, when posting a question you should also show what you have tried so far... some piece of code, printscreens, etc.
Your explanation was not that clear (at least to me), but based on what I have understood, I have made a small code sample for you to get you started. I have broken down the code into the function blocks, so that you can better understand what they are trying to achieve.
Here is the code:
'the following function will find cell with the specific text
Private Function FindCell(ws As Worksheet, strToSearch As String, Optional sColumn As String = "A") As Integer
Dim iCounter As Integer
'as you do not know where exactly it exists, we loop from first cell in the particular row
'to the very last celll
With ws
For iCounter = 1 To .Range("A65000").End(xlUp).Row ' or .UsedRange.Rows.Count, or any other method
If .Range(sColumn & iCounter).Value = strToSearch Then
'yay, we have found the cell!
'pass out the reference
FindCell = iCounter
'now call exit function as we no longer need to continue searching for the cell (we have already found it!)
Exit Function
End If
Next iCounter
End With
'in case the cell does not exist, we can return -1
FindCell = -1
End Function
'the following cell will search the very first cell to the top (starting from specific row), which is blank / empty
Private Function FindEmptyCell(ws As Worksheet, iStartRow As Integer, Optional sColumn As String = "A") As Integer
'This function does the same, as if you have selected specific cell
'and then pressed left Ctrl + Up arrow at the same time
'Try it!
'You can do the same with Right + Left + Bottom arrow as well
FindEmptyCell = ws.Range(sColumn & iStartRow).End(xlUp).Row + 1
End Function
Private Sub EraseRows()
Dim iStartCell As Integer
Dim iEndCell As Integer
On Error GoTo 0
'First let's find the "bottom" cell which is the cell with the specific text you are looking for
iEndCell = FindCell(ActiveSheet, "TextIAmLookingFor")
'now let's see find the top blank cell (so that we get the range of from - to that you want to erase)
iStartCell = FindEmptyCell(ActiveSheet, iEndCell)
'now we can delete the rows!
'iEndCell-1 because you don't want to erase the cell with your search string, right?
ActiveSheet.Rows(CStr(iStartCell) & ":" & CStr(iEndCell - 1)).EntireRow.Delete (xlUp)
End Sub
OP Update:
Thanks for the code KazJaw, it prompted me to change the approach I am trying to tackle the problem with. This is my current code:
Sub Method3()
Dim intFieldCount As Integer
Dim i As Integer
Dim vSt1 As String
intFieldCount = ActiveDocument.Fields.Count
For i = 1 To intFieldCount
ActiveDocument.Fields(i).Select 'selects the first field in the doc
Selection.Expand
vSt1 = Selection.Fields(1).Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
ActiveDocument.Bookmarks(vSt1).Select 'Selects the current crossreference in the ref list
Next i
End Sub
Ok the so the Code currently finds the first field in the document, reads its field code and then jumps to the location in the document to mimic a CTRL+Click.
However, It does this for all types of fields Bookmarks, endnotes, figures, tables etc. I only want to find Reference fields. I thought I could deduce this from the field code but it turns out figures and bookmarks use the same field code layout ie.
A Reference/Boookmark has a field code {REF_REF4123123214\h}
A Figure cross ref has the field code {REF_REF407133655\h}
Is there an effective way to get VBA to distinguish between the two? I was thinking as reference fields in the document are written as (Reference 1) I could find the field and then string compare the word on the left to see if it says "Reference".
I was thinking of using the MoveLeft Method to do this
Selection.MoveLeft
But I can't work out how to move left 1 word from the current selection and select that word instead to do the strcomp
Or perhaps I can check the field type? with...
If Selection.Type = wdFieldRef Then
Do Something
End If
But I am not sure which "Type" i should be looking for.
Any advice is appreciated
All REF fields "reference" bookmarks. Word sets bookmarks on all objects that get a reference for a REF field: figures, headings, etc. There's no way to distinguish from the content of the field what's at the other end. You need to "inspect" that target, which you can do without actually selecting it. For example, you could check whether the first six letters are "Figure".
The code you have is inefficient - there's no need to use the Selection object to get the field code. The following is more efficient:
Sub Method3()
Dim fld As Word.Field
Dim rng as Word.Range
Dim vSt1 As String
ForEach fld in ActiveDocument.Fields
vSt1 = fld.Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
Set rng = ActiveDocument.Bookmarks(vSt1).Range
If Left(rng.Text, 6) <> "Figure" Then
rng.Select
End If
Next
End Sub