Hallo Reinhard,
Ist jetzt quasi deine Anfrage erledigt,
Ja, danke!!
dann zeige doch den Code wenn er gut klappt, nachfolgende
freuen sich wenn sie ihn dann im Archiv finden.
Das hatte ich (nach Test) eh vor, aber danke für den Hinwewis!
Das Ganze wird mit einer Schaltfäche in der Tabelle1 gestartet.
Option Explicit
'Suche nach "Application.FileSearch"
'
'Wenn dieses Programm nicht läuft,
'dann (bis Excel 2003) in Menü Extras/Makro/Sicherheit
'im Register "Vertrauenswürdige Quellen"
'die Option "Zugriff auf Visual Basic Projekt vertrauen" aktivieren
Sub FilesearchSuche()
Dim CMdl
Dim wkb As Workbook
Dim meld\_pfad As String 'HV für Pfad
Dim meld\_mappe As String 'HV für Excelmappe
Dim meld\_modul As String 'HV für Modulname
Dim meld\_sub As String 'HV für Subroutine oder Funktion
Dim Zei As Long 'aktuelle Schreibzeile
Dim ii As Long
Const Suchwort As String = "Application.FileSearch"
Dim mywks As Worksheet
Set mywks = ThisWorkbook.Worksheets("Tabelle1")
Call Tabelle\_vorbereiten(mywks, Zei)
For Each wkb In Workbooks
meld\_pfad = wkb.Path
meld\_mappe = wkb.Name
For Each CMdl In wkb.VBProject.VBComponents
meld\_sub = ""
meld\_modul = CMdl.Name
With CMdl.CodeModule
If .Find(Suchwort, 1, 1, -1, -1, False, False, True) Then
For ii = 1 To CMdl.CodeModule.CountOfLines
If InStr(.Lines(ii, 1), "Sub ") \> 0 Or InStr(.Lines(ii, 1), "Function ") \> 0 Then
meld\_sub = Trim(Mid(.Lines(ii, 1), 1, InStr(.Lines(ii, 1), "(") - 1))
End If
If InStr(.Lines(ii, 1), Suchwort) \> 0 Then
Zei = Zei + 1
mywks.Cells(Zei, 1).Value = meld\_pfad
mywks.Cells(Zei, 2).Value = meld\_mappe
mywks.Cells(Zei, 3).Value = meld\_modul
mywks.Cells(Zei, 4).Value = meld\_sub
End If
Next ii
End If
End With
Next CMdl
Next wkb
Application.ScreenUpdating = False
mywks.Range(Cells(5, 1), Cells(Zei, 4)).Columns.AutoFit
mywks.PageSetup.PrintArea = "$A$1:blush:d$" & Zei
mywks.Range("d3").Select '"Parkstellung" (unter der Schaltfäche)
Application.ScreenUpdating = True
End Sub
Sub Tabelle\_vorbereiten(mywks, Zei)
Application.ScreenUpdating = False 'gegen Geflackere
Columns("A:smiley:").Select
Selection.Clear
Zei = 2
mywks.Cells(Zei, 1).Value = "Suche nach Application.FileSearch"
Rows(Zei).Font.Bold = True
Rows(Zei).Font.Size = 12
Zei = Zei + 1
mywks.Cells(Zei, 1).Value = "im Pfad " & ThisWorkbook.Path
Zei = Zei + 2
mywks.Cells(Zei, 1).Value = "Pfad"
mywks.Cells(Zei, 2).Value = "Datei"
mywks.Cells(Zei, 3).Value = "Modul"
mywks.Cells(Zei, 4).Value = "Sub/Function"
Rows(Zei).Font.Bold = True
Application.ScreenUpdating = True
End Sub
Gruß
Jochen
