frm00_Projects              ==================
tblProjectStage
 100          ProjectMainID_Надпись       Шифр проекта
 100          ProjectName_Надпись         Наименование
 100          ProjectShortName_Надпись    Краткое наименование
 100          ProjectCustomerID_Надпись   Шифр Заказчика
 100          ProjectCustomer_Надпись     Заказчик
 100          GIP_Надпись   ГИП
 100          ProjectYear_Надпись         Дата занесения
 100          Comment_Надпись             Comment
 100          Stage_OTR_Надпись           ОТР
 100          Stage_P_Надпись             П
 100          Stage_R_Надпись             Р
 100          IsCapitalObj_Надпись        IsCapitalObj
 100          IsLinearCapitalObj_Надпись  IsLinearCapitalObj
 100          Надпись26     Список проектов
 109          ProjectMainID ProjectMainID
 109          ProjectName   ProjectName
 109          ProjectShortName            ProjectShortName
 109          ProjectCustomerID           ProjectCustomerID
 109          ProjectCustomer             ProjectCustomer
 109          ProjectYear   ProjectYear
 109          Comment       Comment
 106          Stage_OTR     ====
 106          Stage_P       ====
 106          Stage_R       ====
 109          IsCapitalObj  IsCapitalObj
 109          IsLinearCapitalObj          IsLinearCapitalObj
 102          Линия28       ====
 111          ПолеСоСписком31             GIP///SELECT Сотрудники.id_w, Сотрудники.WorkerFamily FROM Сотрудники WHERE (((Сотрудники.WorkerPosition)="ГИП")); 
 104          Кнопка29      Редактировать проект
 104          Кнопка30      Создать проект

Dim a As Control
For Each a In Controls
Debug.Print  a.ControlType,a.Name
Next

Option Compare Database
Option Explicit
Dim doc As DAO.Document
Dim dbs As DAO.Database

Dim s1
Sub mspravka()
If Len(Dir("c:\temp\forms\*.*")) > 0 Then
Kill "c:\temp\forms\*.*"
End If

If Len(Dir("c:\temp\reports\*.*")) > 0 Then
Kill "c:\temp\reports\*.*"
End If

mform
mreport
End Sub
Sub mform()

Dim frm As Form
Set dbs = CurrentDb
For Each doc In dbs.Containers("forms").Documents
s1 = doc.Name
Debug.Print s1
DoCmd.OpenForm s1, acDesign, , , , acHidden
mcolor s1, , 1
DoCmd.Close acForm, s1, acSaveYes
Next doc
End Sub

Sub mreport()

Dim frm As Report
Set dbs = CurrentDb
For Each doc In dbs.Containers("reports").Documents
s1 = doc.Name
Debug.Print s1
DoCmd.OpenReport s1, acDesign, , , , acHidden
mcolor s1, "reports", 1
DoCmd.Close acReport, s1, acSaveYes
Next doc
End Sub


Sub mcolor(sname, Optional stype As String = "forms", Optional r As Long = 0)
If Len(Dir("c:\temp", vbDirectory)) = 0 Then
MkDir "c:\temp"
End If

If Len(Dir("c:\temp\forms", vbDirectory)) = 0 Then
MkDir "c:\temp\forms"
End If

If Len(Dir("c:\temp\reports", vbDirectory)) = 0 Then
MkDir "c:\temp\reports"
End If

If r = 0 Then Exit Sub
''''''''
Dim CTR As Control
Dim OBJ As Object
Dim frm As Form
Dim rpt As Report
Dim que As DAO.QueryDef
Dim s1, J1, sname1
Reset


If stype = "forms" Then
For Each frm In Forms
If frm.Name = sname Then
Set OBJ = Forms(sname)
sname1 = zamena(sname)
Open "c:\temp\forms\" & sname1 & ".txt" For Output As #1
GoTo n_frm
End If
Next frm
MsgBox sname & " no found"
Exit Sub

Else
''Set obj = Reports(sname)
''Open "c:\temp\reports\" & sname & ".txt" For Output As #1
For Each rpt In Reports
If rpt.Name = sname Then
Set OBJ = Reports(sname)
sname1 = zamena(sname)
Open "c:\temp\Reports\" & sname1 & ".txt" For Output As #1
GoTo n_frm
End If
Next rpt
MsgBox sname & " no found"
Exit Sub
End If
''''''''''''''''''''''''''''
n_frm:



Debug.Print OBJ.Name, "=================="
Print #1, OBJ.Name, "=================="
s1 = OBJ.RecordSource
Print #1, s1
Debug.Print s1
'''''''''''''''
For Each que In CurrentDb.QueryDefs
If InStr(s1, "SELECT ") = 0 Then
J1 = 0
End If
If LCase(que.Name) = LCase(s1) Then
Print #1, que.SQL
Print #1, "================"
Exit For
End If
Next que
''''''''''''''''
For Each CTR In OBJ.Controls
J1 = CTR.ControlType
Print #1, J1, CTR.Name,
If J1 = 109 Then
s1 = CTR.ControlSource

If Mid(s1, 1, 1) = "=" Then
Debug.Print J1, CTR.Name, s1
CTR.BackColor = vbGreen

Else
CTR.BackColor = vbYellow
End If
ElseIf J1 = 100 Or J1 = 104 Then
s1 = CTR.Caption
ElseIf J1 = 111 Then
s1 = CTR.ControlSource & "///" & CTR.RowSource



Else
s1 = "===="
End If
s1 = Replace(s1, Chr(13), "~")
s1 = Replace(s1, Chr(10), "~")
s1 = Replace(s1, Chr(11), "~")

Print #1, s1
Next CTR
Reset
End Sub
Function zamena(zname)
Dim sw
sw = zname
sw = Replace(sw, ".", "_")
sw = Replace(sw, ",", "_")
sw = Replace(sw, "\", "_")
sw = Replace(sw, "/", "_")
sw = Replace(sw, """", "_")
sw = Replace(sw, "'", "_")
zamena = sw
End Function