Форум программистов, компьютерный форум, киберфорум
Наши страницы
MS Access
Войти
Регистрация
Восстановить пароль
Другие темы раздела
MS Access создание главной страницы http://www.cyberforum.ru/ms-access/thread60491.html
Здравствуйте. Сильно извиняюсь, но нужно помощь. Честно сказать я чайник в базах данных. но командованием поставлена задача и нужно ее выполнять. в принципе я в общих чертах разобрался с программой и...
MS Access Расчет нагрузки преподавателей Всем доброе время суток. Пожалуйста, составьте, кто может, следующую БД. Очень нужно, а я в этом плохо разбираюсь. условие: Расчет нагрузки преподавателей. Составить БД расчета нагрузки... http://www.cyberforum.ru/ms-access/thread60465.html
проектирование реляционных баз данных MS Access
Специализированная научная библиотека Рассмотрим специализированную библиотеку, которая располагает книжным фондом определенной тематической направленности. Предполагается, что каждая книга фонда...
Запрос Расчет итогов и динамики поставок и продаж MS Access
Здраствуйте! Помогите,пожалуйста, разобраться с запросом: Операция должна рассчитывать и выводить на экран суммарные величины объемов и стоимостей поставок и продаж топлива каждой марки и их разницу...
MS Access Создание запроса на основании ДАТЫ http://www.cyberforum.ru/ms-access/thread60360.html
Здравствуйте! Помогите,пожалуйста, разобраться. Имеется БД по учету тех.осмотра промышленных датчиков, приборов и т.д. У каждого прибора (датчика) имееются свои сроки проведения тех.осмотра,...
MS Access БД по Access. Запросы Доброго времени суток! Ни как не могу разобраться вот с таким запросом: Вывод информации о неоплаченных, частично оплаченных заказах и заказах, по кото-рым продукция вовремя не поставлена или... подробнее
Aeliot
175 / 60 / 3
Регистрация: 17.11.2011
Сообщений: 318
11.02.2012, 16:26 0

Делимся наработками

11.02.2012, 16:26. Просмотров 189951. Ответов 133
Метки (Все метки)

Ответ

Порой наступает такой момент, что в базе нужно что-то изменить, но уже не помнишь всех связей или никогда не знал, поскольку правишь чужой проект.
На такой случай сделал две формы.
1-я) Осуществляет поиск чего-либо в текстах всех запросов, сохранённых в базе и в источниках строк полей таблиц, если есть подстановочные поля.
2-я) Ищет формы и их элементы, в которых использованы те или иные запросы.

За одно, в них реализован "массовый" поиск неиспользуемых запросов.

В атаче архив базы, сделанной в 2010-м аксесе.
(в 2003-й не получилось сохранить)

Для тех, кто не сможет открыть этот файл:
- Текст первой формы
Form_frmAdmLookForQuery.cls
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmAdmLookForQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
 
Private Const coTitle As String = "Поиск запросов"
 
Private Sub cmdLookAll_Click()
    If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _
                        & "Это может занять значительное время." _
                        , vbYesNo + vbQuestion, coTitle) _
    Then Exit Sub
    
    Dim blnPresent As Boolean
    Dim blnRS As Boolean
    Dim blnRST As Boolean
    Dim fld As Field
    Dim objQueryLF As QueryDef
    Dim objQueryLI As QueryDef
    Dim prp As Property
    Dim strLookFor As String
    Dim strQueryName As String
    Dim strSQL As String
    Dim strTabName As String
    Dim td As TableDef
    
    On Error GoTo ErrorHandler
    
    ' отключаем обновление экрана
    Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _
                            & "Это может занять значительное время. Подождите..."
    
    ' очищаем список запросов перед поиском
    Me.lstQuery.RowSource = ""
        
    ' ищем запросы в запросах, сохранённых в базе
    Me.lstQuery.AddItem "----- Начало списка -----"
    For Each objQueryLF In CurrentDb.QueryDefs
        strLookFor = objQueryLF.Name
        If Left(strLookFor, 1) <> "~" Then
            blnPresent = False
            ' перечитываем запросы, сохранённые в базе
            For Each objQueryLI In CurrentDb.QueryDefs
                strQueryName = objQueryLI.Name
                If Left(strQueryName, 1) <> "~" Then
                    ' если запрос содержит в теле искомую строку
                    If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then
                        ' отмечаем, что данный запрос используется
                        blnPresent = True
                        Exit For
                    End If
                End If
            Next objQueryLI
            
            ' если искомый запрос не обнаружен
            If Not blnPresent Then
                ' добавляем имя запроса в список, если ренее не добавили
                Call AddInListBox(strLookFor, strLookFor)
            End If
        End If
    Next objQueryLF
    
    ' ищем запросы в таблицах, сохранённых в базе
    Me.lstQuery.AddItem "----- Конец списка -----"
    For Each objQueryLF In CurrentDb.QueryDefs
        strLookFor = objQueryLF.Name
        If Left(strLookFor, 1) <> "~" Then
            ' перечитываем все таблицы, сохранённые в базе
            For Each td In CurrentDb.TableDefs
                strTabName = td.Name
                If Left(strTabName, 4) <> "MSys" _
                And Left(strTabName, 4) <> "USys" _
                And Left(strTabName, 7) <> "tblSinc" _
                Then
                    For Each fld In td.Fields
                        blnRS = False
                        blnRST = False
                        
                        For Each prp In fld.Properties
                            If prp.Name = "RowSourceType" Then blnRST = True
                            If prp.Name = "RowSource" Then blnRS = True
                        Next prp
                        
                        ' если это подстановочное поле
                        If blnRS And blnRST Then
                            ' если источник строк содержит искомую строку
                            If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then
                                ' отмечаем, что данный запрос используется
                                blnPresent = True
                                Exit For
                            End If
                        End If
                    Next fld
                    
                    ' если искомый запрос обнаружен
                    If blnPresent Then
                        ' удаляем имя запроса из списка
                        Me.lstQuery.RowSource = Replace(Me.lstQuery.RowSource, ";" & strQueryName & ";", ";")
                    End If
                End If
            Next td
        End If
    Next objQueryLF
    
    ' включаем обновление экрана
    Application.Echo True, "Получение свойств завершено."
    MsgBox "Обработка окончена", , coTitle
    
    Exit Sub
    
ErrorHandler:
    Call ErrMsg(Me.Caption) ' матюгальник
    Resume Next
End Sub
 
Private Sub cmdLookFor_Click()
    ' получаем список запросов, содержащих введённый текст, а также
    ' таблиц и их полей, у которых источник строк содержит введённый текст
        
    'If vbYes <> MsgBox("Произвести поиск запросов по образцу?" _
    '                    , vbYesNo + vbQuestion, coTitle) _
    'Then Exit Sub
    
    Dim blnRS As Boolean
    Dim blnRST As Boolean
    Dim fld As Field
    Dim objQueryLI As QueryDef
    Dim prp As Property
    Dim strLookFor As String
    Dim strQueryName As String
    Dim strSQL As String
    Dim strTabName As String
    Dim td As TableDef
    
    On Error GoTo ErrorHandler
    
    strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)
    If strLookFor <> "" Then
        ' отключаем обновление экрана
        Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."
        
        ' очищаем список запросов перед поиском
        Me.lstQuery.RowSource = ""
        
        ' получаем список запросов, содержащих введённый текст
        Me.lstQuery.AddItem "----- Запросы -----"
        ' перечитываем все запросы, сохранённые в базе
        For Each objQueryLI In CurrentDb.QueryDefs
            strQueryName = objQueryLI.Name
            If Left(strQueryName, 1) <> "~" Then
                ' если запрос содержит в теле искомую строку
                If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then
                    ' добавляем имя запроса в список, если ренее не добавили
                    Call AddInListBox(strQueryName, strQueryName)
                End If
            End If
        Next objQueryLI
        
        ' получаем список таблиц и их полей, у которых источник строк содержит введённый текст
        Me.lstQuery.AddItem "----- Таблицы -----"
        ' перечитываем все таблицы, сохранённые в базе
        For Each td In CurrentDb.TableDefs
            strTabName = td.Name
            If Left(strTabName, 4) <> "MSys" _
            And Left(strTabName, 4) <> "USys" _
            And Left(strTabName, 7) <> "tblSinc" _
            Then
                For Each fld In td.Fields
                    blnRS = False
                    blnRST = False
                    
                    For Each prp In fld.Properties
                        If prp.Name = "RowSourceType" Then blnRST = True
                        If prp.Name = "RowSource" Then blnRS = True
                    Next prp
                    
                    ' если это подстановочное поле
                    If blnRS And blnRST Then
                        ' если источник строк содержит искомую строку
                        If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then
                            ' добавляем имя таблицы в список, если ренее не добавили
                            Call AddInListBox(strTabName, strTabName)
                            ' добавляем имя поля в список, если ренее не добавили
                            Call AddInListBox(fld.Name, ".          " & fld.Name)
                        End If
                    End If
                Next fld
            End If
        Next td
        
        ' включаем обновление экрана
        Application.Echo True, "Получение свойств завершено."
        MsgBox "Обработка окончена", , coTitle
    Else
        MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _
                , vbExclamation, coTitle
    End If
    
    Exit Sub
    
ErrorHandler:
    Call ErrMsg(Me.Caption) ' матюгальник
    Resume Next
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Me.txbLookFor.Value = Null
    Me.lstQuery.RowSource = ""
End Sub
 
Private Function AddInListBox( _
        strLookFor As String _
        , strAdd As String _
        ) As Boolean
    
    On Error GoTo ErrorHandler
    
    If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then
        Me.lstQuery.AddItem strAdd
        AddInListBox = True
    Else
        AddInListBox = False
    End If
    
    Exit Function
    
ErrorHandler:
    Call ErrMsg(Me.Caption) ' матюгальник
    Resume Next
End Function

- Текст второй формы
Form_frmAdmLookForQueryOnForm.cls
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Form_frmAdmLookForQueryOnForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
 
Const coTitle As String = "Поиск форм и их элементов"
    
Private Sub cmdLookAll_Click()
    If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _
                        & "Это может занять значительное время." _
                        , vbYesNo + vbQuestion, coTitle) _
    Then Exit Sub
    
    Dim blnPresent As Boolean
    Dim ctl As Control
    Dim objFrm As AccessObject
    Dim prp As Property
    Dim q As Long
    Dim strObjName As String
    Dim strSource As String
    Dim strLookFor As String
    
    On Error GoTo ErrorHandler
    
    ' отключаем обновление экрана
    Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _
                            & "Это может занять значительное время. Подождите..."
    
    ' очищаем список запросов перед поиском
    Me.lstQuery.RowSource = ""
    
    For q = 0 To lstLookFor.ListCount - 1
        strLookFor = lstLookFor.Column(0, q)
        If strLookFor <> "" Then
            blnPresent = False
            ' перечитываем все формы, сохранённые в базе
            For Each objFrm In CurrentProject.AllForms
                strObjName = objFrm.Name
                Select Case strObjName
                    ' список форм, исключённых из обработки
                    Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"
                    Case Else
                        ' открываем форму
                        DoCmd.OpenForm strObjName, acDesign
                        
                        ' выбираем свойство "источник записей"
                        Set prp = Forms(strObjName).Properties("RecordSource")
                        ' изсеняем источник данных
                        If Not IsNull(prp.Value) Then
                            strSource = prp.Value
                            If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
                                blnPresent = True
                            End If
                        End If
                        
                        If Not blnPresent Then
                            ' перечитываем элементы формы
                            For Each ctl In Forms(strObjName).Controls
                                ' выбираем свойство "тип элемента"
                                Set prp = ctl.Properties("ControlType")
                                ' если это ComboBox
                                If prp.Value = 111 Then
                                    ' выбираем свойство "источник строк"
                                    Set prp = ctl.Properties("RowSource")
                                    ' изсеняем источник данных
                                    If Not IsNull(prp.Value) Then
                                        strSource = prp.Value
                                        If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
                                            blnPresent = True
                                            Exit For
                                        End If
                                    End If
                                End If
                            Next ctl
                        End If
                        
                        ' закрываем форму с сохранением изменений
                        DoCmd.Close acForm, strObjName, acSaveNo
                        
                        ' выходим из цыкла, если нашла запрос
                        If blnPresent Then Exit For
                End Select
            Next objFrm
            
            If Not blnPresent Then
                If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then
                    Me.lstQuery.AddItem strLookFor
                End If
            End If
        End If
    Next q
    
    ' включаем обновление экрана
    Application.Echo True, "Получение свойств завершено."
    MsgBox "Обработка окончена", , coTitle
    
    Exit Sub
    
ErrorHandler:
    Call ErrMsg(Me.Caption) ' матюгальник
    Resume Next
End Sub
 
Private Sub cmdLookFor_Click()
    If vbYes <> MsgBox("Произвести поиск форм и их элементов по имени запроса с которым они связаны?" _
                        , vbYesNo + vbQuestion, coTitle) _
    Then Exit Sub
    
    Dim ctl As Control
    Dim objFrm As AccessObject
    Dim prp As Property
    Dim strObjName As String
    Dim strSource As String
    Dim strLookFor As String
    
    On Error GoTo ErrorHandler
    
    strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)
    If strLookFor <> "" Then
        ' отключаем обновление экрана
        Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."
        
        ' очищаем список запросов перед поиском
        Me.lstQuery.RowSource = ""
        
        ' перечитываем все формы, сохранённые в базе
        For Each objFrm In CurrentProject.AllForms
            strObjName = objFrm.Name
            Select Case strObjName
                ' список форм, исключённых из обработки
                Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"
                Case Else
                    ' открываем форму
                    DoCmd.OpenForm strObjName, acDesign
                    
                    ' выбираем свойство "источник записей"
                    Set prp = Forms(strObjName).Properties("RecordSource")
                    ' изсеняем источник данных
                    If Not IsNull(prp.Value) Then
                        strSource = prp.Value
                        If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
                            Me.lstQuery.AddItem strObjName
                        End If
                    End If
                    
                    ' перечитываем элементы формы
                    For Each ctl In Forms(strObjName).Controls
                        ' выбираем свойство "тип элемента"
                        Set prp = ctl.Properties("ControlType")
                        ' если это ComboBox
                        If prp.Value = 111 Then
                            ' выбираем свойство "источник строк"
                            Set prp = ctl.Properties("RowSource")
                            ' изсеняем источник данных
                            If Not IsNull(prp.Value) Then
                                strSource = prp.Value
                                If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
                                    Me.lstQuery.AddItem ctl.Name & " on " & strObjName
                                End If
                            End If
                        End If
                    Next ctl
                    
                    ' закрываем форму с сохранением изменений
                    DoCmd.Close acForm, strObjName, acSaveNo
            End Select
        Next objFrm
        
        ' включаем обновление экрана
        Application.Echo True, "Получение свойств завершено."
        MsgBox "Обработка окончена", , coTitle
    Else
        MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _
                , vbExclamation, coTitle
    End If
    
    Exit Sub
    
ErrorHandler:
    Call ErrMsg(Me.Caption) ' матюгальник
    Resume Next
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    txbLookFor.Value = Null
    lstQuery.RowSource = ""
    lstLookFor.RowSource = ""
End Sub

- Функция
ErrMsg
Visual Basic
1
2
3
4
5
6
7
8
Public Sub ErrMsg( _
        Optional strTitle As String = "Error" _
        )
    If Err <> 0 Then
        MsgBox Err.Source & " --> " & Err.Description, , strTitle
        Err.Clear
    End If
End Sub


Вернуться к обсуждению:
Делимся наработками
5
Вложения
Тип файла: zip Database.zip (31.3 Кб, 741 просмотров)
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
11.02.2012, 16:26

Делимся vpn)
Ребят, накидайте vpn серверов работающих на просторах СНГ.

Делимся опытом
Добрый день! Давайте делиться мыслями о разработках, которые прямо не...

FX-6300, делимся опытом
Всем здрасте. Вот хотел спросить у вас, кто чего добился в разгоне 6300? Я...

0
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru