title image


Smiley Afaik hilft da nur Disziplin, denn es gibt iirc
kein "Ereignis", das beim Anlegen einer Routine ausgelöst wird. Da hilft nur Disziplin.



Und vielleicht ein abendliches Parsen des Codes, um darin festzustellen, daß bei jeder Routine die ersten drei Zeilen Kommentar der genannten Art sind. Das ist aber halt nur eine Kontrolle, kein Sicherstellen. Zum Auslesen aller Routinen habe ich von Reinhard ein paar segensreiche Zeilen im Einsatz:







Public Function ShowSubsAndFunctions(Optional blnMitCode As Boolean = False)

'Alle Module (auch Klassenmodule in Formularen oder Berichten)

'werden mit ihren Subs und Functions in eine Datei geschrieben.

'Lautet das Argument auf true, wird auch der Code des Modules ausgegeben

'(als formatierte Datei mit Trennblöcken etc), ansonsten stehen nur die Namen der

'Routinen satzweise untereinander (Einlesbar in die doku.mdb zur technischen Recherche).



'Steuerfunz zu Funktion ListAllFunctionsInModule.

'Thx and Kudos to Reinhard Kraasch @ Kraasch.de :-D

Dim Mdl, frm As Form, Doc As Document, _

db As Database, Cont As Container, _

Lin As Long, rpt As Report, ref

Dim strReferences As String





'Sicherstellen der Existenz der Datei

If Dir("c:\routines.txt") "" Then

Kill "c:\routines.txt"

End If

'Datei anlegen und Überschriften eindrucken

Open "c:\routines.txt" For Append As #1

Print #1, "Verzeichnis der Module, Funktionen und Subs"

If blnMitCode Then

Print #1, "Aufbau: Modulname, Namen der enthaltenen Subs, Code"

End If

Print #1, 'leerzeile





'Ausgeben der Verweise

For Each ref In Application.References

strReferences = strReferences & ";" & ref.Name & " in " & ref.FullPath

Next ref

If blnMitCode Then

Print #1, "Verweise:"

For Each ref In Split(strReferences, ";")

Print #1, ref

Next ref

End If



Close 1



'echte Module drucken

For Mdl = 0 To Modules.Count - 1

Open "c:\routines.txt" For Append As #1

If blnMitCode Then

Print #1, 'Leerzeile

Print #1, 'Leerzeile

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* MODUL (standalone): " & Modules(Mdl).Name & ", LOC: " & Modules(Mdl).CountOfLines

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "Enthaltenene Routinen:"

End If

Close 1

ShowAllFunctionsInModule Modules(Mdl) 'druckt nur die Namen der Routinen in die Datei

If blnMitCode Then 'wenn gewünscht, Code mit eintragen

Open "c:\routines.txt" For Append As #1

Print #1,

Print #1, "Code:"

Print #1,

For Lin = 1 To Modules(Mdl).CountOfLines 'alle Zeilen des Moduls (Zählung beginnt mit 1)

Print #1, Modules(Mdl).Lines(Lin, 1)

'Trennlinie nach jedem End Sub/End Function

If InStr(1, Modules(Mdl).Lines(Lin, 1), "End Sub") 0 _

Or InStr(1, Modules(Mdl).Lines(Lin, 1), "End Function") 0 Then

Print #1,

Print #1, "================================================================="

Print #1, "=======================Ende Sub/Function========================="

Print #1, "================================================================="

Print #1,

End If

Next Lin

Print #1,

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* ENDE MODUL *"

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1,

Close 1

End If

Next Mdl





'Klassenmodule (Formularcode) drucken

Set db = CurrentDb

Set Cont = db.Containers!Forms

For Each Doc In Cont.Documents

DoCmd.OpenForm Doc.Name, acDesign, , , , acHidden

Set frm = Forms(Doc.Name)

Open "c:\routines.txt" For Append As #1

If blnMitCode Then

Print #1, 'leerzeile

Print #1, 'Leerzeile

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* MODUL (Formularintern): " & frm.Module & ", LOC: " & frm.Module.CountOfLines

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "Enthaltenene Routinen:"

End If

Close 1

ShowAllFunctionsInModule frm.Module

If blnMitCode Then 'wenn gewünscht, Code mit eintragen

Open "c:\routines.txt" For Append As #1

Print #1,

Print #1, "Code:"

Print #1,

DoCmd.OpenModule frm.Module

For Lin = 1 To Modules(frm.Module).CountOfLines

Print #1, Modules(frm.Module).Lines(Lin, 1)

'Trennlinie nach jedem End Sub/End Function

If InStr(1, Modules(frm.Module).Lines(Lin, 1), "End Sub") 0 _

Or InStr(1, Modules(frm.Module).Lines(Lin, 1), "End Function") 0 Then

Print #1,

Print #1, "================================================================="

Print #1, "=======================Ende Sub/Function========================="

Print #1, "================================================================="

Print #1,

End If

Next Lin

DoCmd.Close acModule, frm.Module

Print #1,

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* ENDE MODUL *"

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1,

Close 1

End If

DoCmd.Close acForm, Doc.Name, acSaveNo

Next Doc





'Klassenmodule in Berichten drucken

Set Cont = db.Containers!Reports

For Each Doc In Cont.Documents

DoCmd.OpenReport Doc.Name, acViewDesign

Set rpt = Reports(Doc.Name)

Open "c:\routines.txt" For Append As #1

If blnMitCode Then

Print #1,

Print #1,

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* MODUL (Berichtsintern): " & rpt.Module & ", LOC: " & rpt.Module.CountOfLines

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "Enthaltenene Routinen:"

End If

Close 1

ShowAllFunctionsInModule rpt.Module

If blnMitCode Then 'wenn gewünscht, Code mit eintragen

Open "c:\routines.txt" For Append As #1

Print #1,

Print #1, "Code:"

Print #1,

DoCmd.OpenModule rpt.Module

For Lin = 1 To Modules(rpt.Module).CountOfLines 'beginnt mit 1

Print #1, Modules(rpt.Module).Lines(Lin, 1)

'Trennlinie nach jedem End Sub/End Function

If InStr(1, Modules(rpt.Module).Lines(Lin, 1), "End Sub") 0 _

Or InStr(1, Modules(rpt.Module).Lines(Lin, 1), "End Function") 0 Then

Print #1,

Print #1, "================================================================="

Print #1, "=======================Ende Sub/Function========================="

Print #1, "================================================================="

Print #1,

End If

Next Lin

DoCmd.Close acModule, rpt.Module

Print #1,

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1, "* ENDE MODUL *"

Print #1, "*****************************************************************"

Print #1, "*****************************************************************"

Print #1,

Close 1

End If

DoCmd.Close acReport, Doc.Name, acSaveNo

Next Doc

Set db = Nothing

End Function







zusammen mit







Public Function ShowAllFunctionsInModule(Mdl As Module)

'Die Namen aller Subs und Functions im angegebenen Modul werden in eine Datei geschrieben

'Thx and Kudos to Reinhard Kraasch @ kraasch.de

Dim Lin As String, w, i As Long, j As Long

For i = 1 To Mdl.CountOfLines

Lin = Mdl.Lines(i, 1)

w = Split(Lin, " ") 'Trennen der Zeile anhand der Leerzeichen (= Trenner)

If UBound(w) > 0 Then

If w(0) = "Public" Or w(0) = "Private" Then 'entfernen von Public- und Private-Anw. aus dem Array w()

For j = 0 To UBound(w) - 1

w(j) = w(j + 1)

Next j

End If

If w(0) = "Sub" Or w(0) = "Function" Then 'alles andere sind Deklarationen oder Kommentare

Open "c:\routines.txt" For Append Shared As #1

'Ausgabe des Modulnamens, Routinennamens (bis zur ersten öffnenden Klammer)

Print #1, Mdl.Name & ";" & Mid(w(1), 1, InStr(w(1), "(") - 1)

Close 1

End If

End If

Next i

End Function









HTH


Martin
Atrus2711 ät gmx punkt net
Meine Beiträge zu MS Office betreffen stets Version 2000,
wenn nicht anders angegeben.




geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: