|
Subject:
|
string same name as Sub
|
|
Posted By:
|
crmpicco
|
Post Date:
|
1/6/2006 9:31:22 AM
|
Sub TP_UKtoPortugal_RT_mapColours()
'... variables for error handling
Const sErrorSource As String = "TP_UKtoPortugal_RT_mapColours()"
Is there a way to have the string the same name as the Sub name - without hard-coding it?
Picco
www.crmpicco.co.uk
|
|
Reply By:
|
maccas
|
Reply Date:
|
1/6/2006 11:50:40 AM
|
Unfortunatly not.
The best workaround for this type of problem that I've seen is to run a routine to "prep" all subs prior to running anything. The code below is a basic example of how to achieve this.
NB you'll need to add a reference to VBIDE (Microsoft Visual Basic for Applications Extensibility) to get this to work.
Sub InsertProcName(strModuleName As String)
Dim VBCodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim InsertLine As Long
Dim Msg As String
Dim ProcName As String
Dim test As String
' Initialise the code module variable
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(strModuleName).CodeModule
With VBCodeMod
' Start on the line after the declarations at the top - they're not relevant
StartLine = .CountOfDeclarationLines + 1
' Loop through all of the lines on the code pane
Do Until StartLine >= .CountOfLines
' Find the procedure's name
ProcName = .ProcOfLine(StartLine, vbext_pk_Proc)
' Find the first line of the procedure's line number
StartLine = .ProcBodyLine(ProcName, vbext_pk_Proc)
' Constant declaration line to insert
Msg = "Const sErrorSource As String = """ & ProcName & """"
' Position to insert Constant declaration line
InsertLine = StartLine + ProcHeaderLen(VBCodeMod, ProcName)
' Insert constant declaration line if not already there
If .Lines(InsertLine, 1) <> Msg Then .InsertLines InsertLine, Msg
' Move down to the next procedure
StartLine = StartLine + .ProcCountLines(ProcName, vbext_pk_Proc)
Loop
End With
End Sub
Private Function ProcHeaderLen(CodeMod As VBIDE.CodeModule, ProcName As String) As Long
Dim Counter As Long
Dim LineNum As Long
Dim C As String
' Find the first header line
LineNum = CodeMod.ProcBodyLine(ProcName, vbext_pk_Proc)
' Find the character on the RH end of this line
C = Right(CodeMod.Lines(LineNum, 1), 1)
' Whilst the RH character is "_" the header is being continued so loop down until it is not
Do While C = "_"
Counter = Counter + 1
C = Right(CodeMod.Lines(LineNum + Counter, 1), 1)
Loop
' Add one for the first line
Counter = Counter + 1
' Output the result
ProcHeaderLen = Counter
End Function
|
