tramite VBA sapere se esiste già una sub o function in un modulo di una cartella

Question

avendo risolto il problema di scrivere una procedura con il VBA in excel

non so come interrogare, sempre col VBA, se esista una Sub o function

in un modulo di una cartella.

qualcuno sa aiutarmi?

Answer 1

Ciao Anonymous,

avendo risolto il problema di scrivere una procedura con il VBA in excel

non so come interrogare, sempre col VBA, se esista una Sub o function

in un modulo di una cartella.

qualcuno sa aiutarmi?

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

'\ Inserisce un riferimento alla library:

'\ Microsoft Visual Basic For Applications Extensiblity 5.3

    Dim VBProj As VBIDE.VBProject

    Dim VBComp As VBIDE.VBComponent

    Dim CodeMod As VBIDE.CodeModule

    Dim iLine As Long

    Dim sMsg As String, sStr As String, sTitle As String

    Dim bFound As Boolean

    Const MiaProcedura As String = "TuaMacro"

    Const aStr = "Trovato!"

    sStr = "La procedura " & MiaProcedura & " "

    Set VBProj = ActiveWorkbook.VBProject

    For Each VBComp In VBProj.VBComponents

        Set CodeMod = VBComp.CodeModule

        With CodeMod

            On Error Resume Next

            iLine = CodeMod.ProcStartLine(MiaProcedura, vbext_pk_Proc)

            If Err.Number = 0 Then

                bFound = True

                sMsg = sStr & "e` stata trovato nel Modulo  : " _

                     & vbNewLine & vbTab _

                     & CodeMod _

                     & vbNewLine _

                     & "alla riga : " _

                     & vbNewLine & vbTab _

                     & iLine

                sTitle = aStr

                GoTo XIT

            End If

        End With

        Err.Clear

    Next VBComp

    If Not bFound Then

        sMsg = sStr & "non  e` stato " & "trovato"

        sTitle = "Non " & aStr

    End If

XIT:

    Call MsgBox( _

         Prompt:=sMsg, _

         Buttons:=vbInformation, _

         Title:=sTitle)

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Anonymous,

Mi fa piacere che tu abbia risolto il problema e ti ringrazio per il cortese riscontro.

Per chiudere questo thread, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman

Answer 3

Grazie Norman, ne ho fatto una function:

Public Function TestEsistenzaProcedura(MiaProcedura As String, flag)

'\ Inserisce un riferimento alla library:

'\ Microsoft Visual Basic For Applications Extensiblity 5.3

'  con flag=0 rende Vero o Falso     con flag=1 rende  stringa

    Dim VBProj As VBIDE.VBProject

    Dim VBComp As VBIDE.VBComponent

    Dim CodeMod As VBIDE.CodeModule

    Dim iLine As Long

    Dim sMsg As Variant, sStr As String, sTitle As String, aStr As String

    Dim bFound As Boolean

    bFound = False

    Set VBProj = ActiveWorkbook.VBProject

    For Each VBComp In VBProj.VBComponents

        Set CodeMod = VBComp.CodeModule

        With CodeMod

            On Error Resume Next

            iLine = CodeMod.ProcStartLine(MiaProcedura, vbext_pk_Proc)

            If Err.Number = 0 Then

                bFound = True

                GoTo XIT

            End If

        End With

        Err.Clear

    Next VBComp

XIT:

  If flag Then

    aStr = "Trovato!"

    sStr = "La procedura <" & MiaProcedura & "> "

    If Not bFound Then

        sStr = sStr & Chr(10) & "non  e` stata " & "trovata" & " nel Modulo <" & CodeMod & ">"

        sTitle = "Non " & aStr

       sMsg = sStr

    Else

        sStr = sStr & Chr(10) & "e` stata trovata" & " nel Modulo <" & CodeMod & ">"

        sStr = sStr & Chr(10) & "della cartella <" & ActiveWorkbook.Name & ">"

        sStr = sStr & Chr(10) & "alla riga <" & iLine & ">"

        sTitle = aStr

       sMsg = sStr

    End If

 Else

   sMsg = bFound

 End If

TestEsistenzaProcedura = sMsg

End Function