View Single Post
  #6   Report Post  
scattered
 
Posts: n/a
Default

Amit,
Here is a final version of the code I posted before. I have removed the
arbitrary restriction that ToDo blocks must begin with a whole-line
comment. The listing now provides the names and types of the procedures
in which a ToDo block is located. Finally, I have given a version
"ToDoReport" which sends output to a text file instead of the Immediate
window. The only drawback is that you need to add references to both
the VBA Extensibility and the Scripting Runtime libraries.

Typical output now looks like:

--------------------------------------------------
ToDo List for VBAProject(StackExample.xls)
--------------------------------------------------
1) Sheet1, Line 11, Procedure btnCreate_Click:
to do: create a peek function

2) Sheet2, Line 65, Procedure btnParse_Click:
to do: modify sub to parse infix as well as postfix expressions

3) Stack, Line 3, Get IsEmpty:
to do: add a count property

4) frmMain, Line 4, Procedure btnOk_Click:
to do: check to see that all options selected

The code:

__________________________________________________ _________________

Option Explicit

'This module is designed to implement a simple VBE ToDo list
'
'The ToDos are represented by comments or comment blocks
'which begin with "To do" or "ToDo". The output of the program
'is either printed to the Immediate Window or dumped to a text file
'To use this type "ToDoList" in the Immediate Window from anywhere
'in the project. Type "ToDoList False" or "ToDoList ListAll := False"
'to localize the list to the component whose code window you are
'currently viewing. To print to a file type "ToDoReport" (with an
'optional false as before).
'
'Make Sure to include references to the Microsoft VBA Extensibility
'Library and the Microsoft Scripting Runtime Library
'in your project via tools-references.

Private toDoCount As Long
Private toDoString As String

Sub ToDoList(Optional ListAll As Boolean = True)
GetToDoList ListAll
Debug.Print toDoString
End Sub

Sub ToDoReport(Optional ListAll As Boolean = True)
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim defaultName As String
Dim fileName As Variant

defaultName = ActiveWorkbook.Name & "ToDo.txt"
fileName = Application.GetSaveAsFilename(defaultName, _
"Text files (*.txt),*.txt", , "To Do Report")

If fileName Then
GetToDoList (ListAll)
Set ts = fso.CreateTextFile(fileName)
ts.Write toDoString
ts.Close
End If
End Sub

Private Sub GetToDoList(ListAll As Boolean)
Dim myVBE As VBIDE.VBE
Set myVBE = Application.VBE
Dim myProj As VBIDE.VBProject
Set myProj = myVBE.ActiveVBProject
Dim cmp As VBIDE.VBComponent
Dim myName As String, title As String
Dim A As Variant

A = Split(myProj.fileName, "\")
myName = A(UBound(A))
title = "ToDo List for " & myProj.Name _
& "(" & myName & ")"
toDoString = String(50, "-") & vbCrLf
toDoCount = 0

If ListAll Then
toDoString = toDoString & title & vbCrLf _
& String(50, "-") & vbCrLf
For Each cmp In myProj.VBComponents
Check4ToDos cmp
Next cmp
Else
Set cmp = myVBE.ActiveCodePane.CodeModule.Parent
toDoString = toDoString & title & ", " _
& cmp.Name & vbCrLf & String(50, "-") & vbCrLf
Check4ToDos cmp
End If

If toDoCount = 0 Then
toDoString = toDoString & "No items to display"
End If

End Sub

Private Sub Check4ToDos(cmp As VBIDE.VBComponent)
Dim i As Long, n As Long
Dim codeLine As String
Dim ToDo As String
Dim myCode As VBIDE.CodeModule
Set myCode = cmp.CodeModule
Dim procKind As vbext_ProcKind
Dim procName As String
Dim A As Variant
n = myCode.CountOfLines
i = 1
Do While i <= n
codeLine = myCode.Lines(i, 1)
If Not codeLine Like "*'*" Then 'not a candidate
i = i + 1
Else
A = Split(codeLine, "'")
codeLine = A(UBound(A))
codeLine = "'" & LTrim(codeLine)
If UCase(LTrim(Mid(codeLine, 2))) Like "TO DO*" Or _
UCase(LTrim(Mid(codeLine, 2))) Like "TODO*" Then
'In a ToDo block!
toDoCount = toDoCount + 1
procName = myCode.ProcOfLine(i, procKind)
If Len(procName) 0 Then
procName = ", " & KindString(procKind) & procName
End If
toDoString = toDoString & toDoCount _
& ") " & cmp.Name & ", Line " _
& i & procName & ":" & vbCrLf
Do While i <= n And LTrim(codeLine) Like "'*"
toDoString = toDoString _
& Mid(LTrim(codeLine), 2) & vbCrLf
i = i + 1
If i <= n Then codeLine = myCode.Lines(i, 1)
Loop
toDoString = toDoString & vbCrLf
Else
i = i + 1
End If
End If
Loop
End Sub

Private Function KindString(procKind As vbext_ProcKind) As String
Select Case procKind
Case vbext_pk_Get
KindString = "Get "
Case vbext_pk_Let
KindString = "Let "
Case vbext_pk_Set
KindString = "Set "
Case vbext_pk_Proc
KindString = "Procedure "
End Select
End Function

__________________________________________________ _____

Hope this helps

-John Coleman