Форум программистов, компьютерный форум, киберфорум
Наши страницы

MS Access

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 2, средняя оценка - 4.00
БурундукЪ
9547 / 2545 / 66
Регистрация: 17.02.2009
Сообщений: 10,364
#1

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

03.11.2009, 11:04. Просмотров 171204. Ответов 98
Метки нет (Все метки)

в этой теме предлагаю выкладывать интересные наработки по акцессу...

зы. в дальнейшем на основе их можно будет создать темы "важное"

Добавлено через 45 секунд
ззы. флуд и спам в этой теме будет награжден красными карточками
14
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
03.11.2009, 11:04
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Делимся наработками (MS Access):

Для рубрики "Делимся наработками", добить БД поставка-сделка авто - MS Access
День добрый, форумчане. Хочу довести до ума БД, чтобы добавить в раздел форума "Делимся наработками", так как там нашел только отдаленно...

Строковый тип данных. С наработками. Работает, но не верно - Pascal
Написать программу определения в заданной строке номера первого по порядку слова, которое короче своего предшественника и число вхождений в...

Делимся. - Web
Доброго времени суток всем посетителям этой темы!=) Хочу попросить вас поделиться самой откровенной информацией по нескольким...

Делимся знаниями по С++ - C++
По вашему зачем нужна виртуальная функция в программе? Какой от нее толк если она вызывается как обычная функция. Да я знаю что...

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

Ведьмак 2: делимся впечатлениями - RPG
Кто уже играл, поделитесь впечатлениями. То есть: лучше ли Ведьмак 2 по сравнению с Ведьмак, плюсы, минусы, в общем стоит ли брать игру?

98
diam
402 / 75 / 7
Регистрация: 06.12.2009
Сообщений: 296
05.05.2011, 13:43 #16
Вот моя надстройка. Это надстройка для Access 97 (мы до сих пор на нем работаем). Неспешно правлю её для 2003 акцесса.

Кому интересно, поковыряв, - сможет для себя почерпнуть немного умного для создания надстроек.

Надстройка дописывает в контекстное меню базы полезные команды.
'Теперь вы сможете ОДНИМ правым щелчком мыши
'"Переприсоединить таблицу" -переприсоединить таблицы и даже вьюшки с сохранением ключевого поля
'"Поиск в запросах и источниках строк" -сделать поиск выделенной таблицы/запроса или выделенного текста во всех запросах базы и источниках данных для форм/отчетов
'"Найти объект" -сделать поиск объекта среди объектов базы данных (таблиц, запросов, форм, отчетов, модулей). Для этого выделите название объекта в модуле или в запросе и воспользуйтесь контекстным меню "Найти объект".
'"Вставить обработчик ошибок" -добавить в код обработчик ошибок (для этого выделите нужный код и выберите контекстном меню команду
'"Структурировать модуль" - отформатировать текущий модуль или все модули базы (в том числе и модули форм и отчетов). Отформатировать, то есть проставить отступы внутри блоков IF-END IF, FOR-NEXT, SELECT CASE-END SELECT и другие. А то бывает дорабатываешь чью-то базу и умираешь от желания вырвать руки предыдущему разработчику. Но это доступно только в панели инструментов, а не в контекстном меню.

Установка проста - запустите файл и нажмите установить. Создастся контекстное меню. Чтобы создать панель инструментов надо выполнить: Сервис-Надстройки-DevelopInHelp-"Создать панель инструментов"
2
Вложения
Тип файла: zip Dvlp_97.zip (163.3 Кб, 320 просмотров)
Тип файла: zip Dvlp_97(Исправленный) (2).zip (149.7 Кб, 596 просмотров)
elinka
15 / 15 / 0
Регистрация: 23.10.2010
Сообщений: 56
05.05.2011, 14:40 #17
вот еще две базы данных нашла. может кому пригодится
5
Вложения
Тип файла: rar служба быта.rar (1.38 Мб, 2338 просмотров)
Тип файла: rar зоомагазин.rar (6.07 Мб, 6632 просмотров)
diam
402 / 75 / 7
Регистрация: 06.12.2009
Сообщений: 296
05.05.2011, 16:26 #18
Просьба к модераторам заменить файл, приложенный постом выше
Делимся наработками
на тот, что приложен в этом сообщении. Исправил ошибку с поиском строки в запросах базы.
2
Вложения
Тип файла: zip Dvlp_97(Исправленный).zip (149.6 Кб, 597 просмотров)
Pelena
2128 / 1195 / 190
Регистрация: 25.10.2010
Сообщений: 1,912
21.05.2011, 20:44 #19
Есть готовые базы данных. Когда-то помогала делать курсовые работы
Может кому пригодится
7
Вложения
Тип файла: rar Отпуск товара.rar (171.6 Кб, 3056 просмотров)
Тип файла: rar Инвентарная ведомость.rar (35.3 Кб, 2543 просмотров)
Agapov_stas
3323 / 1726 / 76
Регистрация: 05.08.2010
Сообщений: 4,425
Завершенные тесты: 1
19.07.2011, 12:36 #20
БД "Библиотека"
Прием\выдача книг.
Пользователи, пароли, авторизация.
Отображение контроллов в зависимости от пользователя.
История посещения пользователей.
Список задолжников.
"Архив" сотрудников.
Резервная копия БД(с выбором папки куда сохранять)
Иконка Access-а.
И др.

Возможно кому-то что-нибудь понадобится

P.S. пароль для всех - 12345. Защиты от Shift-а никакой нет.

P.P.S. сильно не судить, делал просто так, от нечего заняться.
11
Вложения
Тип файла: rar Библиотека.rar (526.4 Кб, 4802 просмотров)
Итен
3 / 3 / 0
Регистрация: 17.08.2011
Сообщений: 27
24.08.2011, 12:47 #21
Так можно возвартить в поле формы результата запроса
1
RuzvM
0 / 0 / 0
Регистрация: 06.11.2011
Сообщений: 1
10.11.2011, 08:54 #22
Kucha_primerov_ACCESS.rar тут много всяких примеров написанных на VBA в access(аксесс):
- визуализация линейки для лучшей читабельности
- проект маркетинга
- подчиненная форма в подчиненной
- навароченный листбокс
- эффект заставки
- эффект прозрачности
- пример справочника
- и т. д.
0
Aeliot
175 / 60 / 1
Регистрация: 17.11.2011
Сообщений: 318
22.11.2011, 14:07 #23
Модель работы с разделённой базой данных без линковки таблиц (даже временной). Если папку с таблицами защитить средствами NTFS (именно для этого они в отдельной папке), получается некий аналог защиты при помощи терминального доступа к серверу. За одно "упрощён" интерфейс пользователя и поставлена защита от <Shift>
В архиве:
- файл с таблицами
- файл с формами для Юзверя
- файл с формами для админа (чтоб можно было покопаться)

Пароли: 123
3
Вложения
Тип файла: rar accdb_NoLincs_2.rar (195.3 Кб, 1519 просмотров)
BlackWizard0
3 / 3 / 0
Регистрация: 29.04.2011
Сообщений: 13
05.12.2011, 16:00 #24
На основе своей базы данных сделал сетевую игру "Быки - коровы".

Может пригодиться как примеры:
- переходы между окнами (правда делал давно, сейчас бы сделал по-другому: не выводил бы поля на стартовое окно, а доставал бы данные из таблиц с помощью SQL-запросов)
- выполнение авторизации, управление пользователями, доступом к окнам;
- выполнение автообновления;
- защита от открытия Shift-ом.


Файл с таблицами BK_date.mdb необходимо разместить на сетевом диске, доступном для всех пользователей.
Если на разных компах разные буквы сетевого диска, можно в настройках месторасположения прописать
путь как \\IP_comp\source.

BK_main.mde - файл с формами (интерфейсный) - необходимо размещать у пользователя на компе.
BK_main.mdb - файл для админа, который он может модернизировать.

Файлы BK_date и BK_main должны быть на разных дисках (иметь разные буквы дисков).

Для отключения защиты от открытия Shift-ом необходимо зайти админом.

Для выполнения автообновления:
- создается новая версия файла BK_main.mde, где в настройках указывается следующая версия файла (версия локального файла).
- этот файл записывается в то место, где размещен файл с таблицами BK_date.mdb.
- в настойках указывается, что сетевая версия уже тоже имеет новый номер.
- при запуске у пользователя произойдет автообновление при условии, что в имени пути нет русских букв (с кодировкой не разбирался).

В пользователей и админа не установлены пароли - устанавливайте сами.
2
Вложения
Тип файла: rar DB_B_K.rar (2.61 Мб, 1096 просмотров)
Aeliot
175 / 60 / 1
Регистрация: 17.11.2011
Сообщений: 318
11.02.2012, 16:26 #25
Порой наступает такой момент, что в базе нужно что-то изменить, но уже не помнишь всех связей или никогда не знал, поскольку правишь чужой проект.
На такой случай сделал две формы.
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 Кб, 668 просмотров)
Tdutybq
-13 / 3 / 1
Регистрация: 18.01.2012
Сообщений: 83
21.03.2012, 17:36 #26
Учет успеваемости стулентов
1
Вложения
Тип файла: rar База данных1.rar (102.4 Кб, 3740 просмотров)
В.В.С.
32 / 32 / 1
Регистрация: 02.03.2012
Сообщений: 90
27.03.2012, 09:11 #27
На скорую руку набросал функцию прописи денежных рублевых сумм
Функция VBA
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
Function NumToText(ByVal Num As Double) As String
 ' Возвращает числовое значение прописью в виде текста
 ' Ххххх ххххх хххххх рублей YY копееек
Dim Num_, Num0, Num1, Num2, Num3, Num4, Num5, Num6, Num7, Num8 As Integer
Dim Dig(1 To 19) As String  ' цифры и числа от 1 до 19
Dim Dec(1 To 10) As String  ' десятки
Dim Sot(1 To 9) As String   ' сотни
Dim strText1, strText2 As String
Dim L As Integer
Dig(1) = "один"
Dig(2) = "два"
Dig(3) = "три"
Dig(4) = "четыре"
Dig(5) = "пять"
Dig(6) = "шесть"
Dig(7) = "семь"
Dig(8) = "восемь"
Dig(9) = "девять"
Dig(10) = "десять"
Dig(11) = "одиннадцать"
Dig(12) = "двенадцать"
Dig(13) = "тринадцать"
Dig(14) = "четырнадцать"
Dig(15) = "пятнадцать"
Dig(16) = "шестнадцать"
Dig(17) = "семнадцать"
Dig(18) = "восемнадцать"
Dig(19) = "девятнадцать"
 
Dec(1) = "десять"
Dec(2) = "двадцать"
Dec(3) = "тридцать"
Dec(4) = "сорок"
Dec(5) = "пятьдесят"
Dec(6) = "шестьдесят"
Dec(7) = "семьдесят"
Dec(8) = "восемьдесят"
Dec(9) = "девяносто"
 
Sot(1) = "сто"
Sot(2) = "двести"
Sot(3) = "триста"
Sot(4) = "четыреста"
Sot(5) = "пятьсот"
Sot(6) = "шестьсот"
Sot(7) = "семьсот"
Sot(8) = "восемьсот"
Sot(9) = "девятьсот"
 
Num8 = Fix(Num / 100000000)
Num7 = Fix((Num - Num8 * 100000000) / 10000000)
Num6 = Fix((Num - Num8 * 100000000 - Num7 * 10000000) / 1000000)
Num5 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000) / 100000)
Num4 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000) / 10000)
Num3 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000) / 1000)
Num2 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000) / 100)
Num1 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100) / 10)
Num0 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100 - Num1 * 10))
Num_ = Fix((Num - Fix(Num)) * 100)
 
NumToText = ""
Select Case Num8    ' сотни миллионов
   Case Is > 9
        NumToText = "число > 999 999 999.99"
   Case Is > 0
        NumToText = NumToText & Sot(Num8)
End Select
 
Select Case Num7    ' десятки миллионов
   Case Is > 1
        NumToText = NumToText & " " & Dec(Num7)
   Case Is = 1
        If Num6 = 0 Then
            NumToText = NumToText & " десять миллионов "
        Else
            NumToText = NumToText & " " & Dig(Num7 * 10 + Num6) & " миллионов "
        End If
        GoTo Tysachi
End Select
                    ' единицы миллионов
If Num6 > 0 And Num7 <> 1 Then NumToText = NumToText & " " & Dig(Num6)
 
If NumToText <> "" Then
    Select Case Num6
        Case Is > 4
            NumToText = NumToText & " миллионов "
        Case Is > 1
            NumToText = NumToText & " миллиона "
        Case Is = 1
            NumToText = NumToText & " миллион "
        Case Is = 0
            NumToText = NumToText & " миллионов "
    End Select
End If
 
                    ' сотни тысяч
Tysachi:
If Num5 > 0 Then NumToText = NumToText & " " & Sot(Num5)
 
Select Case Num4    ' десятки тысяч
   Case Is > 1
        NumToText = NumToText & " " & Dec(Num4)
   Case Is = 1
        If Num3 = 0 Then
            NumToText = NumToText & " десять тысяч "
        Else
            NumToText = NumToText & " " & Dig(Num4 * 10 + Num3) & " тысяч "
        End If
        GoTo Rubl
End Select
                    ' единицы тысяч
Select Case Num3
    Case Is = 1
        NumToText = NumToText & " одна"
    Case Is = 2
        NumToText = NumToText & " две"
    Case Is > 2
        NumToText = NumToText & " " & Dig(Num3)
End Select
 
If Num5 <> 0 Or Num4 <> 0 Or Num3 <> 0 Then
    Select Case Num3
        Case Is > 4
            NumToText = NumToText & " тысяч "
        Case Is > 1
            NumToText = NumToText & " тысячи "
        Case Is = 1
            NumToText = NumToText & " тысяча "
        Case Else
            NumToText = NumToText & " тысяч "
    End Select
End If
                    ' сотни рублей
Rubl:
If Num2 > 0 Then NumToText = NumToText & Sot(Num2)
 
Select Case Num1    ' десятки рублей
   Case Is > 1
        NumToText = NumToText & " " & Dec(Num1)
   Case Is = 1
        If Num0 = 0 Then
            NumToText = NumToText & " десять рублей"
        Else
            NumToText = NumToText & " " & Dig(Num1 * 10 + Num0) & " рублей"
        End If
        GoTo Kopeika
End Select
                    ' единицы рублей
If Num0 > 0 And Num1 <> 1 Then NumToText = NumToText & " " & Dig(Num0)
 
Select Case Num0
   Case Is > 4
        NumToText = NumToText & " рублей "
   Case Is > 1
        NumToText = NumToText & " рубля "
   Case Is = 1
        NumToText = NumToText & " рубль "
   Case Is = 0
        NumToText = NumToText & " рублей "
End Select
Kopeika:
                    ' копейки
NumToText = NumToText & " " & Format(Num_, "00")
Select Case Num_
    Case Is > 4
        NumToText = NumToText & " копеек"
    Case Is > 1
        NumToText = NumToText & " копейки"
    Case Is = 1
        NumToText = NumToText & " копейка"
    Case Is = 0
        NumToText = NumToText & " копеек"
End Select
            ' заглавная первая буква
NumToText = LTrim(NumToText)
L = Len(NumToText)
strText1 = Left(NumToText, 1)
strText2 = Right(NumToText, L - 1)
NumToText = UCase(strText1) & strText2
End Function
3
Gepar
1180 / 536 / 20
Регистрация: 01.07.2009
Сообщений: 3,517
27.04.2012, 18:12 #28
Делал вот курсовую БД ДАІ. Может пригодится кому. В арихве отчёт + скрин схемы данных + сама бд в аксесе 2010.
В отчёте описана в частности нормализация (почему таблица должна выглядеть так, а не иначе). Всё на украинском.
2
Миниатюры
Делимся наработками  
Вложения
Тип файла: zip ДАІ.zip (1.57 Мб, 1211 просмотров)
dinX
11 / 11 / 0
Регистрация: 25.02.2012
Сообщений: 9
25.06.2012, 20:06 #29
База данных метролога - учет средств измерений. Можно и не СИ. Не все доделано. Но пользоваться уже можно. Пароль 12345. База разделенная. Просто Access. Можно править, при желании. Реализовано: парольный доступ, уровни доступа, вывод в Excel, разные отчеты, выборки, журнал изменений(не полный), и др.
8
Вложения
Тип файла: rar База Данных СИ.rar (1.09 Мб, 2015 просмотров)
diam
402 / 75 / 7
Регистрация: 06.12.2009
Сообщений: 296
05.09.2012, 13:28 #30
Написал библиотеку для использования в приложениях MS Office и Visual Basic для распознавания капчи с использованием сервиса распознавания капч http://Antigate.com

Библиотека реализует следующие функции сервиса:
Распознавание капчи из файла
Распознавание капчи из URL
Распознавание капчи из потока
При распознавании могут быть использованы все дополнительные параметры капчи, принимаемые сервисом.
Возможность пожаловаться на неправильно разгаданную капчу
Запрос баланса
Запрос статистики системы
3
Вложения
Тип файла: zip AG_Tools_dll.zip (163.8 Кб, 287 просмотров)
05.09.2012, 13:28
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
05.09.2012, 13:28
Привет! Вот еще темы с ответами:

Делимся результатами 3dMark`11 - Выбор компьютера
виложуєм в ету тему свои результати в 11 маку и конфигурации

Qt: Учимся вместе. Делимся опытом. - C++ Qt
Сейчас я пытаюсь осваивать Qt. Я плохо знаю C++ и Qt в частности... поэтому часто бывают моменты, когда для решения, казалось бы, простой...

Реальные программы - делимся со всеми - C#
Давайте делиться реальными прогами на С#, т.к. у всех возникают часто похожие проблемы в коде и их можно обсудить на Конкретных примерах....

Делимся опытом встреч с WannaCry(pt) - Безопасность
Профессионалы компьютерной безопасности, рабочие сервис-центров или просто сосед-хакер-ы, поделитесь своим опытом встреч с wannacry, и...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
30
Ответ Создать тему
Опции темы

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