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

@BasicMan · Регистрация: 17.02.2009

Студворк — интернет-сервис помощи студентам

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

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

Добавлено через 45 секунд
ззы. флуд и спам в этой теме будет награжден красными карточками

@Итен · 24.08.2011, 12:47

Так можно возвартить в поле формы результата запроса

10.11.2011, 08:54

Kucha_primerov_ACCESS.rar тут много всяких примеров написанных на VBA в access(аксесс):
- визуализация линейки для лучшей читабельности
- проект маркетинга
- подчиненная форма в подчиненной
- навароченный листбокс
- эффект заставки
- эффект прозрачности
- пример справочника
- и т. д.

@Aeliot · 22.11.2011, 14:07

Модель работы с разделённой базой данных без линковки таблиц (даже временной). Если папку с таблицами защитить средствами NTFS (именно для этого они в отдельной папке), получается некий аналог защиты при помощи терминального доступа к серверу. За одно "упрощён" интерфейс пользователя и поставлена защита от <Shift>
В архиве:
- файл с таблицами
- файл с формами для Юзверя
- файл с формами для админа (чтоб можно было покопаться)

Пароли: 123

@BlackWizard0 · 05.12.2011, 16:00

На основе своей базы данных сделал сетевую игру "Быки - коровы".

Может пригодиться как примеры:
- переходы между окнами (правда делал давно, сейчас бы сделал по-другому: не выводил бы поля на стартовое окно, а доставал бы данные из таблиц с помощью 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.
- в настойках указывается, что сетевая версия уже тоже имеет новый номер.
- при запуске у пользователя произойдет автообновление при условии, что в имени пути нет русских букв (с кодировкой не разбирался).

В пользователей и админа не установлены пароли - устанавливайте сами.

@Aeliot · 11.02.2012, 16:26

Порой наступает такой момент, что в базе нужно что-то изменить, но уже не помнишь всех связей или никогда не знал, поскольку правишь чужой проект.
На такой случай сделал две формы.
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

@Tdutybq · 21.03.2012, 17:36

Учет успеваемости стулентов

@В.В.С. · 27.03.2012, 09:11

На скорую руку набросал функцию прописи денежных рублевых сумм

Функция 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

@Gepar · 27.04.2012, 18:12

Делал вот курсовую БД ДАІ. Может пригодится кому. В арихве отчёт + скрин схемы данных + сама бд в аксесе 2010.
В отчёте описана в частности нормализация (почему таблица должна выглядеть так, а не иначе). Всё на украинском.

@dinX · 25.06.2012, 20:06

База данных метролога - учет средств измерений. Можно и не СИ. Не все доделано. Но пользоваться уже можно. Пароль 12345. База разделенная. Просто Access. Можно править, при желании. Реализовано: парольный доступ, уровни доступа, вывод в Excel, разные отчеты, выборки, журнал изменений(не полный), и др.

@diam · 05.09.2012, 13:28

Написал библиотеку для использования в приложениях MS Office и Visual Basic для распознавания капчи с использованием сервиса распознавания капч http://Antigate.com

Библиотека реализует следующие функции сервиса:
Распознавание капчи из файла
Распознавание капчи из URL
Распознавание капчи из потока
При распознавании могут быть использованы все дополнительные параметры капчи, принимаемые сервисом.
Возможность пожаловаться на неправильно разгаданную капчу
Запрос баланса
Запрос статистики системы

@diam · 07.09.2012, 15:46

Вот программа с исходниками. Программа ищет человека в базе данных приставов через официальный сайт. При ручном поиске надо самому лезть на сайт, вбивать человека, выбирать регион, вводить капчу и потом ждать результата. Программа автоматически заполняет поля на странице, выбирает регион, если нужно отгадывать капчу - отсылает её в сервис антикапчи, и так в цикле для всех регионов. Ответ парсит и, в случае нахождения человека в списке должников, сохраняет информацию об исполнительном производстве.
Также пользователь может вбить человека, выбрать регион и по кнопке просто открыть ИЕ на странице судебных приставов. Все необходимые поля, такие как фио, дата рождения, регион, - будут заполнены и даже нажата кнопка "Искать".

В программе предусмотрена возможность использования прокси.

@diam · 17.10.2012, 12:47

С доктором вебом (а именно с компонентами Gate и Mail) была проблема при работе с моей программой судебных приставов. Тут описание проблемы и решение:
Что-то вырезает файл из передачи по WinHttpRequest

@murcha86 · 19.01.2013, 21:42

Интересную ссылку нашел с примерами запросов в Access

mobile · 19.01.2013, 22:02

Сообщение от murcha86

Интересную ссылку нашел с примерами запросов в Access

Если действительно есть желание овладеть SQL, лучший выход пойти на тренировочный сайт sql-ex.ru. Многие гуру-базовики паслись там подолгу.

@evgenii3000 · 06.02.2013, 13:32

Программа CRM (Система управления взаимоотношениями с клиентами)
храниться инфа по названию фирмы.
можно записывать историю, контакты, сайт почту и другое. напоминает что назначена встреча или тел звонок на сегодня и можно печатать тех задание на сегодня
access 2010 и разделена база. нужно указать путь заново. будут вопросы пишите в личку

@VinniPuh · 13.04.2013, 00:26

Извините. Может по Недомыслию влез не в туда, в куда надо, но может коиу пригодится для создания БД.
Лазил по интернету (нужно было), а так как фанат БД, зацепил списки регионов РФ а соответственно и населенных пунктов с кодами АТС. Создал по своему разумению БД - "Регионы Стран" с кодами АТС населенных пунктов. Если кому это тоже интересно и сможет улучщить БД и дополнить недостающие сведения, предлагаю восполнять и улучшать их, (Выкладывая на - самом ЛУЧЩЕМ И ЛЮБИМОМ форуме - "Форум Базы данных") - и так до "АБСОЛЮТНОГО СОВЕРШЕНСТВА".
Есле не прав, ПОПРАВЬТЕ, как более старшие и мудрые Единомышленники.

shanemac51 · 16.04.2013, 17:28

студентам на заметку
--------
мини описание базы
поместите модуль в анализируемую базу и вызовите на выполнение

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
Option Compare Database
Option Explicit
 
 
Dim dbs As DAO.Database
Dim prt As DAO.Property
Dim tbl As DAO.TableDef
Dim zapr As DAO.QueryDef
Dim fld As DAO.Field
 
 
Dim ref As Reference
Dim doc As Document
Dim cnt As Control
Dim mdl As Module
Dim frm As Form
Dim rpt As Report
 
Dim j1, j2, s1, s2, s3, s4, n1, n2, n3
Dim szag
 
Sub a_pech_mod130416a()
Reset
Open CurrentDb.Name & "f" For Output As #3
 
Set dbs = CurrentDb
 
 
szag = "'" & Now() & "= = = = = " & dbs.Name & " = = = = ="
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, szag
For Each prt In dbs.Properties
If prt.Type = 0 Then
Print #3, "BP=", prt.Type, prt.Name
Else
Print #3, "BP=", prt.Type, prt.Name, prt.Value
End If
'.Name, prt.Value
Next prt
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'References="; szag
For Each ref In References
Print #3, ref.Name, ref.FullPath
Next ref
'''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'SCRIPTS="; szag
For Each doc In dbs.Containers("SCRIPTS").Documents
n1 = doc.Name
'Print #3, "'\\ "
Print #3, "MK=", n1
Next doc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "TableDefs="; szag
For Each tbl In dbs.TableDefs
n1 = tbl.Name
n2 = "-" & tbl.Connect
Debug.Print tbl.Name
'Print #1, "'\\ "
If Mid(n1, 1, 4) = "MSys" Then
''
ElseIf Len(n2) > 1 Then
Print #3, ""
Print #3, "``t=", n1
Print #3, "\\Connect=", n2
Else
Print #3, ""
Print #3, "``t=", n1; " записей="; tbl.RecordCount; " \\" & tbl.ValidationText
n2 = ""
n3 = ""
 
Dim n4r, n4d
 
n3 = Chr(13) & Chr(10)
'''''''''''''''''''
For Each fld In tbl.Fields
n4d = " //"
n4r = " //"
'On Error Resume Next
Print #3, "`"; fld.Name; "`"; fld.Type; "`"; fld.Size
Debug.Print "`"; fld.Name; "`"; fld.Type; "`"; fld.Size
'fld.d
'n4r = n4r & fld.Properties("RowSource")
'n4d = n4d & fld.Properties("Description")
'On Error GoTo err00
'If Len(n4r) > 3 And Len(n4r) < 2000 Then
'Print #3, "`---подстановка= "; n4r
'End If
'If Len(n4d) > 3 And Len(n4d) < 2000 Then
'Print #3, "`===примечание= "; n4d
'End If
 
n2 = s1
Next fld
 
End If
Next tbl
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'QueryDefs="; szag
For Each zapr In dbs.QueryDefs
n1 = zapr.Name
On Error Resume Next
n2 = "\\"
n2 = " " & zapr.SQL
On Error GoTo err00
'Print #3, "'\\ "
Print #3, ""
Print #3, "``z=", n1
Print #3, n2
Next zapr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, "'forms="; szag
For Each doc In dbs.Containers("forms").Documents
n1 = doc.Name
DoCmd.OpenForm n1, acDesign, , , acFormReadOnly, acHidden
Print #3, "'\\ ==============================="
Print #3, "``F=", n1
Print #3, "источник\\RecordSource="; Forms(n1).RecordSource
 
n2 = ""
n3 = ""
n3 = Chr(13) & Chr(10)
 
'On Error Resume Next
Print #3, ""
'Print #3, "'forms="; szag
For Each cnt In Forms(n1).Controls
s1 = cnt.ControlType
Debug.Print s1
s2 = cnt.Name
Debug.Print s1, s2
s3 = "\\"
'On Error Resume Next
If s1 = acTextBox Then
s3 = cnt.ControlSource
End If
s4 = "\\"
If s1 = acLabel Then
s4 = cnt.Caption
End If
 
Debug.Print s1, s2, s3, s4
s1 = n2 & "`" & s1 & "`" & s2 & "`" & s3 & "`" & s4 & n3
n2 = s1
Next cnt
Print #3, n2
Set mdl = Forms(n1).Module
Print #3, "'\\ "
Print #3, "``модуль формы="; n1; " линий="; mdl.Lines(1, 99999)
DoCmd.Close acForm, n1, acSaveNo
Next doc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, "'reports="; szag
For Each doc In dbs.Containers("reports").Documents
n1 = doc.Name
DoCmd.OpenReport n1, acViewDesign, , , acHidden
Print #3, "'\\ ================================"
Print #3, "``R=", n1
Print #3, "источник\\RecordSource="; Reports(n1).RecordSource
 
n2 = ""
n3 = ""
n3 = Chr(13) & Chr(10)
 
For Each cnt In Reports(n1).Controls
s1 = cnt.ControlType
Debug.Print s1
s2 = cnt.Name
Debug.Print s1, s2
s3 = "\\"
'On Error Resume Next
If s1 = acTextBox Then
s3 = cnt.ControlSource
End If
s4 = "\\"
If s1 = acLabel Then
s4 = cnt.Caption
End If
 
Debug.Print s1, s2, s3, s4
s1 = n2 & "`" & s1 & "`" & s2 & "`" & s3 & "`" & s4 & n3
n2 = s1
Next cnt
Print #3, n2
Set mdl = Reports(n1).Module
Print #3, "'\\ "
Print #3, "``модуль отчета=", n1, ; " линий="; mdl.Lines(1, 99999)
DoCmd.Close acReport, n1, acSaveNo
Next doc
On Error GoTo 0
'On Error GoTo err00
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'modules="; szag
 
For Each doc In dbs.Containers("modules").Documents
n1 = doc.Name
DoCmd.OpenModule n1
Set mdl = Modules(n1)
Print #3, "'\\ "; szag
'Print #3, "modules=", n1
 
Print #3, "``modules="; n1; "  линий="; mdl.CountOfLines
'Print #1, "'\\"
 
Print #3, mdl.Lines(1, 99999)
 
DoCmd.Close acModule, n1
'Next doc
Next doc
Print #3, "'\\fin"
Close #3
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MsgBox " описание базы " & CurrentDb.Name & "f"
Exit Sub
err00:
MsgBox Err.Number & " " & Err.Description
Err.Clear
Resume Next
End Sub

Комментарий модератора

Т.к. уважаемая shanemac51 так и не приложила пример использования, прилагаю свой пример с процедурой в отдельном модуле, которая вызывается по событию Нажатие кнопки

@KotVad · 06.05.2013, 15:36

Выполненная практическая работа - БД «Коммерческая фирма». Что из себя представляет:
Внесение инфы по поставщику, клиентам, моделей авто и цен на них, поставка и сделка (дата, количество, кто оформил). Расчет наличия (остатка), формирование отчета реализации по группе поставщика и общей по периоду, запрос на лидерство сотрудников по продажам. Содержит кнопочные формы, различные запросы (на замену, параметрический и т.д.) sql-запросы и т.д.

В архиве сама БД 2007, схемы концептуальной и реляционной модели, а также отчет - пошаговое описание содержания работы (с картинками ^_^).

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

Обсуждение

@evgenii3000 · 30.05.2013, 11:29

Программа CRM (Система управления взаимоотношениями с клиентами) обсуждения доработка

Создал новую версию программы.
Программа CRM (Система управления взаимоотношениями с клиентами)
Access 2010 (БД не разделенная)
Здесь будем переписываться по поводу доработать и изменить ее. Надеюсь кому то пригодится
Она хранит инфу по фирмы в который обзванивали, название, контакты, историю общения, напоминания, поиск сотрудника который ведет эту фирму. файлы которые относятся к этой фирме (договора, сканы) ФИО менеджера, вид работы, отдел которому передается работа (внутри фирмы) и др.

таблицы и вкладки не скрывал от пользователей. но делаю это стандартным способом.
формы для изменения ФИО сотрудников, вид работ, Контрагент тоже только через таблицы добавляю
файлы храню не в access а "Веб браузер" на диск C:\file\ папки создаются по коду счетчика (порядковый) поэтому нужно ОБЯЗАТЕЛЬНО СОЗДАТЬ ПАПКУ "file" внутри сами создаются уже при создании фирмы и проверяет название фирмы на совпадения.
Если разделить базу то можно пользоваться одновременно до 20 чел иначе перекинуть базу на sql server.
Жду предложений по улучшению и ошибки. постараюсь помочь подогнать под Вас.
форум для обсуждения и вопросов по БД

База на форуме тест

@KotVad · 21.06.2013, 17:41

По работе сделал простую базу с динамическим поиском и отчетом с группировкой.

Задачи: Ввод инфы о человеке и документе, хранение и поиск, отчет с группировкой по документу и по порядку внесения в базу.

Чеки РИК.zip

Новые блоги и статьи Все статьи Все блоги /
Калькулятор для расчета родства russiannick 07.08.2026 1. Задача: Создать калькулятор для расчета родства. Родственных связей существует 8 ступеней, такие как: p - отец P - мать q - муж Q - жена b - брат B - сестра s - сын S - дочь	Мир по моей воле kumehtar 07.08.2026 Когда-то кажется, что всё просто. Ты весь такой светлый. Причиняешь добро. Борешься за справедливость в этом тёмном мире. Потом начинаешь замечать одну неприятную вещь. Почти каждый хороший. . .	Кредитный калькулятор Maks 05.08.2026 Решение задачи по прикладной информатике средствами 1С. Задача: Напишите приложение-калькулятор, которое помогает рассчитывать параметры кредита для аннуитетного и дифференцированного видов. . .	У нас сейчас поговорку "Опять 25" нужно переделать на "Опять +35". kumehtar 04.08.2026 С ностальгией вспоминаю времена моего детства, когда у нас и правда +25 - была максимальная температура летом. Раньше +25 °C реально казались вершиной жары, когда можно было весь день пропадать на. . .
Как ИИ начал спорить и врать (возможно почуяв опасность для себя от индустрии - уход от электроники). Hrethgir 04.08.2026 Недельный диалог, на фоне событий с НПЗ. Да, из спирта можно получать бензин, и это не сложно. Но потом в схеме я решил избавиться от насоса, при этом полностью сделав контроль подачи спирта в. . .	Термопринтер QR701 Argus19 03.08.2026 Термопринтер QR701 Купил два термопринтера QR701. На сэлф-тесте написано: Language: PC936 (GB18030). Что означает, что принтеры могут печатать только латиницу и китайские иероглифы. Так же. . .	Создание формы заимствованного документа Maks 03.08.2026 Задача: Необходимо создать собственную форму заимствованного документа. На форме должен быть реквизит "Покупатель", а также табличная часть со следующими реквизитами: - Расчетный счет покупателя. . .	Задача предоставления скидок покупателям Maks 03.08.2026 Задача: В документе "Продажи" необходимо реализовать функционал предоставления скидок покупателям. Скидка должна автоматически рассчитываться и подставляться в соответствующее поле при выборе. . .

@BasicMan 19318 / 2626 / 84 Регистрация: 17.02.2009 Сообщений: 30,364

	Делимся наработками 03.11.2009, 11:04. Показов 488528. Ответов 282 Метки нет (Все метки) в этой теме предлагаю выкладывать интересные наработки по акцессу... зы. в дальнейшем на основе их можно будет создать темы "важное" Добавлено через 45 секунд ззы. флуд и спам в этой теме будет награжден красными карточками 17

@Итен 3 / 3 / 0 Регистрация: 17.08.2011 Сообщений: 27
	24.08.2011, 12:47
	Так можно возвартить в поле формы результата запроса 1

RuzvM
	10.11.2011, 08:54
	Kucha_primerov_ACCESS.rar тут много всяких примеров написанных на VBA в access(аксесс): - визуализация линейки для лучшей читабельности - проект маркетинга - подчиненная форма в подчиненной - навароченный листбокс - эффект заставки - эффект прозрачности - пример справочника - и т. д.

@diam 846 / 84 / 7 Регистрация: 06.12.2009 Сообщений: 345
	17.10.2012, 12:47
	С доктором вебом (а именно с компонентами Gate и Mail) была проблема при работе с моей программой судебных приставов. Тут описание проблемы и решение: Что-то вырезает файл из передачи по WinHttpRequest 0

@murcha86 126 / 44 / 1 Регистрация: 04.11.2011 Сообщений: 241
	19.01.2013, 21:42
	Интересную ссылку нашел с примерами запросов в Access 2

@KotVad 6 / 6 / 0 Регистрация: 02.05.2013 Сообщений: 18
	06.05.2013, 15:36
	Выполненная практическая работа - БД «Коммерческая фирма». Что из себя представляет: Внесение инфы по поставщику, клиентам, моделей авто и цен на них, поставка и сделка (дата, количество, кто оформил). Расчет наличия (остатка), формирование отчета реализации по группе поставщика и общей по периоду, запрос на лидерство сотрудников по продажам. Содержит кнопочные формы, различные запросы (на замену, параметрический и т.д.) sql-запросы и т.д. В архиве сама БД 2007, схемы концептуальной и реляционной модели, а также отчет - пошаговое описание содержания работы (с картинками ^_^). Пользуйтесь, возможно что-то и недоработано или реализовано криво, выполнял с нуля в качестве обучения, помогая студентке. лаба.zip Обсуждение 1

@evgenii3000 1323 / 542 / 67 Регистрация: 16.01.2013 Сообщений: 4,125
	30.05.2013, 11:29
	Программа CRM (Система управления взаимоотношениями с клиентами) обсуждения доработка Создал новую версию программы. Программа CRM (Система управления взаимоотношениями с клиентами) Access 2010 (БД не разделенная) Здесь будем переписываться по поводу доработать и изменить ее. Надеюсь кому то пригодится Она хранит инфу по фирмы в который обзванивали, название, контакты, историю общения, напоминания, поиск сотрудника который ведет эту фирму. файлы которые относятся к этой фирме (договора, сканы) ФИО менеджера, вид работы, отдел которому передается работа (внутри фирмы) и др. таблицы и вкладки не скрывал от пользователей. но делаю это стандартным способом. формы для изменения ФИО сотрудников, вид работ, Контрагент тоже только через таблицы добавляю файлы храню не в access а "Веб браузер" на диск C:\file\ папки создаются по коду счетчика (порядковый) поэтому нужно ОБЯЗАТЕЛЬНО СОЗДАТЬ ПАПКУ "file" внутри сами создаются уже при создании фирмы и проверяет название фирмы на совпадения. Если разделить базу то можно пользоваться одновременно до 20 чел иначе перекинуть базу на sql server. Жду предложений по улучшению и ошибки. постараюсь помочь подогнать под Вас. форум для обсуждения и вопросов по БД База на форуме тест 0

@KotVad 6 / 6 / 0 Регистрация: 02.05.2013 Сообщений: 18
	21.06.2013, 17:41
	По работе сделал простую базу с динамическим поиском и отчетом с группировкой. Задачи: Ввод инфы о человеке и документе, хранение и поиск, отчет с группировкой по документу и по порядку внесения в базу. Чеки РИК.zip 3