Применяя в запросах WHERE (ГДЕ) Вы сможете отобрать нужные записи. Обратите внимание на то, как отбираются данные по дате и используется ключевое слово LIKE
-- Условие выборки по дате, книге и цене
SELECT * FROM [Данные] WHERE [Дата]=#11/15/2000# and ([Книга]='Война и Мир')
and ([СуммаРуб]=500);
-- Возврат книг по названию, где есть буква В
SELECT * FROM [Данные] WHERE [Книга] LIKE 'В*'
SELECT - это ключевая команда в запросах. С нее начинается построение источников данных для форм, отчетов. Изучите несколько простых примеров ее использования
-- Выборка без таблиц
SELECT "Ура!" as Афиша, "Вперед!" as Лозунг;
-- Выборка всего
SELECT * FROM [Данные];
-- Выборка из 1 поля всех записей
SELECT ALL [Книга] FROM [Данные];
-- Замена имени таблицы
SELECT [T5].КурсUSD From [Данные] as [T5];
-- Выборка 1 записи
SELECT TOP 1 * FROM [Данные];
-- 25 процентов данных
SELECT TOP 25 PERCENT * FROM [Данные] ORDER BY КурсUSD DESC;
-- Уникальные книги
SELECT DISTINCT [Книга] FROM [Данные];
-- Выборка из уникальной таблицы
SELECT * FROM [Данные] WITH OWNERACCESS OPTION
Max - вычисляет в запросе максимальное значение в поле, Min - минимальное, Avg - среднее значение, Last - выбирает последню запись, Sum - суммирует данные.
-- Поиск максимального значения
SELECT Max(КурсUSD) as MaxUSD From [Данные];
-- Выборка среднего значения
SELECT Avg(КурсUSD) as Средний From [Данные];
-- Выборка минимального значения
SELECT Min(КурсUSD) as Минимальный From [Данные];
-- Выборка первого значения
SELECT First(КурсUSD) as Первый From [Данные];
-- Выборка последнего значения
SELECT Last(КурсUSD) as Последний From [Данные];
-- Суммирование полей
SELECT Sum(СуммаРуб) as Сумма From [Данные];
-- Расчет количества
SELECT Count(КурсUSD) as Кол_во From [Данные];
06. Данный пример показывает как можно проверять текстовые документы в Access, используя Word. Дается 2 варианта - быстрый и медленный с вызовом диалога коррекции текста.
' Проверка текста с диалогом
Private Sub butExecute_Click()
Dim app As Word.Application 'Приложение программы
'Dim obj As Object 'Приложение программы, 2 вариант
On Error GoTo 999
' Нужна проверка на ввод текст
If Nz(Me.Text, "") = "" Then
MsgBox "Введите текст!"
Exit Sub
End If
' Сообщение о начале проверки
Me.Result = "Думаю ... Для замены фраз откройте Word"
DoEvents
Set app = New Word.Application
' Set app = CreateObject("Word.Application") ' 2 ��ариант
With app
' Отображаем Word
.Visible = True
' Добавляем документ для проверки
.Documents.Add
' Печатаем проверяемый текст
.Selection.TypeText Me.Text
' Настраиваем опции проверки
.Options.CheckGrammarWithSpelling = False
.Options.IgnoreUppercase = False
' Выполняем проверку
.ActiveDocument.CheckSpelling
' Выбираем новый для проверки текст
.Selection.WholeStory
' Копируем текст в буфер
.Selection.Copy
' Возвращаем результат после проверки
Me.Result = .Selection.Text
' Возвращаем текст из буфера
' Me.Result = Clipboard.GetText
' Закрываем Word
.ActiveDocument.Close (0)
.Quit
End With
' Закрываем приложение
Set app = Nothing
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
End Sub
' Быстрая проверка на наличие ошибок
Private Sub butExecute2_Click()
Dim app As Word.Application
'Dim obj As Object 'Приложение программы, 2 вариант
On Error GoTo 999
' Нужна проверка на ввод текст
If Nz(Me.Text, "") = "" Then
MsgBox "Введите текст!"
Exit Sub
End If
' Сообщение о начале проверки
Me.Result = "Думаю ..."
DoEvents
' Set app = CreateObject("Word.Application") ' 2 вариант
Set app = New Word.Application
' Быстрая проверка
If app.CheckSpelling(Me.Text) Then
Me.Result = "Проверка текста прошла успешно!"
Else
Me.Result = "В тексте есть ошибки"
End If
' Освобождаем память
app.Quit
Set app = Nothing
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
End Sub
02. Этот пример показывает как с использованием API интерфейса определить информацию по дискам системы.
' Запрашиваем информацию о диске
Private Declare Function apiGetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTotalNumberOfClusters As Long) As Long
' Загрузка данных
Private Sub Form_Load()
On Error Resume Next
Me.myDrive.RowSource = funGetDrivers
Me.myDrive = Me.myDrive.Column(0, 0)
myDrive_AfterUpdate
Err.Clear
End Sub
' Получаем информацию о диске системы
Private Function funInformationDisk()
Dim fs, dc, D, s As String
On Error Resume Next
s = ""
' 1. Получаем информацию из файловой системы
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each D In dc
If StrComp(D.DriveLetter, Left(myDrive, 1), vbTextCompare) = 0 Then
s = s "Серийный номер: " D.SerialNumber ";"
s = s "Емкость диска: " Format(D.TotalSize, "#,0") ";"
s = s "Доступный объем диска: " Format(D.AvailableSpace, "#,0") ";"
s = s "Свободное место на диске: " Format(D.FreeSpace, "#,0") ";"
s = s "Метка тома: " D.VolumeName ";"
s = s "Файловая система: " D.FileSystem ";"
Exit For
End If
Err.Clear
Next D
' 2. Получаем информацию из api интерфейса
Dim SectorsPerCluster As Long ' Секторов на клястер
Dim BytesPerSector As Long ' Байт на сектор
Dim NumberOfFreeClustors As Long ' Свободных клястеров
Dim TotalNumberOfClustors As Long ' Всего клястеров
' Запрашиваем свободное место
Call apiGetDiskFreeSpace(Left(Me.myDrive, 2), _
SectorsPerCluster, BytesPerSector, _
NumberOfFreeClustors, TotalNumberOfClustors)
s = s "Число секторов на клястер: " Format(SectorsPerCluster, "#,0") ";"
s = s "Число байт на сектор: " Format(BytesPerSector, "#,0") ";"
s = s "Число свободных клястеров: " Format(NumberOfFreeClustors, "#,0") ";"
s = s "Всего клястеров: " Format(TotalNumberOfClustors, "#,0") ";"
' Используя клястеры Вы можете определить
' a) Емкость диска = TotalNumberOfClustors * SectorsPerCluster * BytesPerSector
' b) Свободное место = NumberOfFreeClustors * SectorsPerCluster * BytesPerSector
' 3. Присваиваем источник данных
Me.myList.RowSource = s
Exit Function
End Function
' Заполняем список с информацией о дисках
Private Function funGetDrivers() As String
Dim fs, dc, D
Dim s As String
On Error GoTo 999
Err.Clear
funGetDrivers = ""
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each D In dc
Select Case D.driveType
Case 0: s = "Неизвестная БД"
Case 1: s = "Дискета"
Case 2: s = "Жесткий диск"
Case 3: s = "Сетевой диск"
Case 4: s = "CD-ROM"
Case 5: s = "RAM диск"
End Select
If D.IsReady Then
funGetDrivers = funGetDrivers D.DriveLetter ":\ - " s ";"
End If
Next
Exit Function
999:
MsgBox Err.Description
Err.Clear
funGetDrivers = ""
End Function
' Обновляем информацию
Private Sub myDrive_AfterUpdate()
funInformationDisk
End Sub
01. В этом примере используется подключение к dbf файлу. Истользуйте пример для загрузки в Access таблиц dbf
Option Compare Database
Option Explicit
'==============================================================
' Связь с таблицами
' Для текущей базы данных
' Предупреждение.
' Если текстовые поля имеют неправильное отображение,
' то установите в Access другую кодировку символов
Private Sub butLink_Click()
Dim myFile As String, s As String
On Error GoTo 999
Select Case Me.grTables
Case 1:
'Данный пример показывает как связать текущую Access
'базу данных с таблицей dBase III: "la_table.dbf"
'с имененем таблицы в Access dbf-таблица
myFile = Application.CurrentProject.Path 'Каталог базы
If Dir(Me.nameFileDbf.Caption) "" Then 'Проверка файла
DoCmd.TransferDatabase acLink, "dBase III", myFile, _
acTable, "la_table.dbf", "dbf-таблица"
'Изменяем вид кнопок формы
setControl True
Else
MsgBox "Нет файла: " Me.nameFileDbf.Caption
End If
End Select
Exit Sub
999:
'Ошибка может быть если dbf-файл находится в каталоге с русским именем
MsgBox "Ошибка связи с таблицей", vbCritical, "Внешние связи"
Err.Clear
'Изменяем свойства элементов формы
setControl False
End Sub
'==============================================================
' Открытие формы
Private Sub Form_Open(Cancel As Integer)
Dim s As String
s = Application.CurrentProject.Path 'Каталог базы
Me.nameFileDbf.Caption = s "\" "la_table.dbf" 'Название файла
butDelLink_Click
End Sub
'==============================================================
' Удаление связи с таблицами
Private Sub butDelLink_Click()
On Error Resume Next
DoCmd.DeleteObject acTable, "dbf-таблица" 'Удаляем связь
'Изменяем свойства элементов формы
setControl False
End Sub
'==============================================================
' Установка элементов формы
Private Sub setControl(myEnabled As Boolean)
Me.grTables.SetFocus 'Меняем фокус
If myEnabled = False Then
Me.nameFileDbf.HyperlinkSubAddress = "" 'Меняем адрес
Me.butLink.Enabled = True 'Меняем вид кнопки
Me.butDelLink.Enabled = False 'Меняем вид кнопки
Else
Me.nameFileDbf.HyperlinkSubAddress = "Table dbf-таблица"
Me.butLink.Enabled = False 'Меняем вид кнопки
Me.butDelLink.Enabled = True 'Меняем вид кнопки
End If
End Sub
01. Есть таблица, в ней нужно провести поиск по нескольким полям. При этом одно поле зависит от другого. Как это сделать указано в это примере.
'==============================================================
' Поиск по дате
Private Sub Дата_AfterUpdate()
Dim rst As Recordset, frm As Form
On Error GoTo 999
Set frm = Me.формаПоиск.Form 'Выбираем форму
Set rst = frm.RecordsetClone 'Выбираем таблицу
rst.FindFirst "([Дата]=#" Format(Me.Дата, "mm\/dd\/yyyy") "#)"
If rst.NoMatch = False Then
frm.Bookmark = rst.Bookmark
Me.Книга = rst!Книга
Else
MsgBox "Нет данных!"
End If
Exit Sub
999:
MsgBox Err.Description vbNewLine "Введите правильно данные?"
End Sub
'==============================================================
' Начать поиск после обновления
Private Sub Книга_AfterUpdate()
recordFind
End Sub
'==============================================================
' Поиск по дате и книге
Private Sub recordFind()
Dim rst As Recordset, frm As Form, s As String
On Error GoTo 999
Set frm = Me.формаПоиск.Form 'Выбираем форму
Set rst = frm.RecordsetClone 'Выбираем таблицу
s = "([Дата]=#" Format(Me.Дата, "mm\/dd\/yyyy") _
"#) and (Книга='" Me.Книга "')"
rst.FindFirst s
If rst.NoMatch = False Then
frm.Bookmark = rst.Bookmark
Else
MsgBox "Нет данных!"
End If
Exit Sub
999:
MsgBox "Введите правильно данные?"
End Sub
'==============================================================
' Поиск по шаблону
Private Sub Шаблон_AfterUpdate()
Dim rst As Recordset, frm As Form, s As String
On Error GoTo 999
Set frm = Me.формаПоиск.Form 'Выбираем форму
Set rst = frm.RecordsetClone 'Выбираем таблицу
rst.FindFirst "([Книга] Like '" Me.Шаблон "')=True"
If rst.NoMatch = False Then
frm.Bookmark = rst.Bookmark
Else
MsgBox "Нет данных!"
End If
Exit Sub
999:
MsgBox "Введите правильно данные?"
End Sub
'==============================================================
' Запрос по книге
Private Sub Книга_Enter()
Me.Книга.RowSource = "SELECT Книга FROM [1-Мои книги] WHERE (((Дата)=[Forms]![Example 01]![Дата]));"
'Me.Книга.Requery 'Изменить запрос
End Sub
03. Этот пример показывает как с использованием API интерфейса определить информацию по Windows, номер версии, платформы и т.п.
' Структура с информацией о версии Windows
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
' Api константы платформы Windows
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
' Получаем информацию о версии
Private Declare Function apiGetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
' Загрузка данных
Private Sub Form_Load()
Dim myVer As OSVERSIONINFO
Dim s As String
' Инициализируем строку
s = ""
' Определяем размер структуры
myVer.dwOSVersionInfoSize = 148
' Получаем информацию о версии
Call apiGetVersionEx(myVer)
If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
s = s "Платформа: Windows 95;"
ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
s = s "Платформа: Windows NT;"
End If
s = s "Версия: " myVer.dwMajorVersion "." myVer.dwMinorVersion ";"
s = s "Построение: " (myVer.dwBuildNumber And HFFFF) ";"
' Устанавливаем список
Me.myList.RowSource = s
End Sub
01. Используя эту функцию, Вы можете загрузить разные курсоры в окно формы Access. Кусоры меняют форму когда вы управляете мышкой.
' Константы из API интерфейса
Const IDC_ARROW = 32512 'Стрелка
Const IDC_IBEAM = 32513 'Тип - I
Const IDC_WAIT = 32514 'Часы
Const IDC_CROSS = 32515 'Перекрестие
Const IDC_UPARROW = 32516 'Верх
Const IDC_SIZE = 32640 'Размер
Const IDC_ICON = 32641
Const IDC_SIZENWSE = 32642 'Стрелки размеров
Const IDC_SIZENESW = 32643
Const IDC_SIZEWE = 32644
Const IDC_SIZENS = 32645
Const IDC_SIZEALL = 32646
Const IDC_NO = 32648 'Стоп курсор
Const IDC_APPSTARTING = 32650 'Стрелка и часы
Const IDC_HAND = 32649
' Загружает курсор из ресурса
Private Declare Function apiLoadCursorBynum Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, _
ByVal lpCursorName As Long) _
As Long
' Устанавливает курсор
Private Declare Function apiSetCursor Lib "user32" Alias "SetCursor" _
(ByVal hCursor As Long) _
As Long
' Загружает курсор из файла
Private Declare Function apiLoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" _
(ByVal lpFileName As String) _
As Long
'Указатель на курсор
Dim hCursor As Long
'==============================================================
' Назначение
' Загружаем курсор
Private Sub Объекты_AfterUpdate()
On Error GoTo 999
Select Case Me.Объекты
Case 1: 'Указатель
hCursor = apiLoadCursorBynum(0, IDC_ARROW)
Case 2: 'Редактор
hCursor = apiLoadCursorBynum(0, IDC_IBEAM)
Case 3: 'Часы
hCursor = apiLoadCursorBynum(0, IDC_WAIT)
Case 4 'Перекрестие
hCursor = apiLoadCursorBynum(0, IDC_CROSS)
Case 5: 'Стрелка вверх
hCursor = apiLoadCursorBynum(0, IDC_UPARROW)
Case 6: 'Размер
hCursor = apiLoadCursorBynum(0, IDC_SIZE)
Case 7: 'Иконка
hCursor = apiLoadCursorBynum(0, IDC_ICON)
Case 8: 'Стрелка
hCursor = apiLoadCursorBynum(0, IDC_SIZENWSE)
Case 9 'Стрелка
hCursor = apiLoadCursorBynum(0, IDC_SIZENESW)
Case 10 'Стрелка
hCursor = apiLoadCursorBynum(0, IDC_SIZEWE)
Case 11 'Стрелка
hCursor = apiLoadCursorBynum(0, IDC_SIZENS)
Case 12 'Стрелка
hCursor = apiLoadCursorBynum(0, IDC_SIZEALL)
Case 13 'Стоп курсор
hCursor = apiLoadCursorBynum(0, IDC_NO)
Case 14 'Старт приложения
hCursor = apiLoadCursorBynum(0, IDC_APPSTARTING)
Case 15 'Загрузить из файла
hCursor = apiLoadCursorFromFile( _
Application.CurrentProject.Path _
"\la_api.cur")
Case 16 'Рука курсор
hCursor = apiLoadCursorBynum(0, IDC_HAND)
End Select
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
End Sub
' Изменяем курсор
Private Sub Пример_01_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Call apiSetCursor(hCursor)
End Sub
01. ADO и DAO - два разных метода доступа к данным реализованы в этом примере. Используйте этот пример для создания новых баз данных из Access. ADOX - это библиотека расширенных функций базы данных.
'==============================================================
' ADOX. Создание базы данных
Private Sub butADO_Click()
Dim cat As New ADOX.Catalog, strmdb As String
' Определение файла
strmdb = Application.CurrentProject.Path "\temp.mdb" ' Путь базы
If Dir(strmdb) "" Then Kill strmdb 'Уничтожаем старую базу данных
' ADOX. Создание базы
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" strmdb
Set cat = Nothing
MsgBox "База создана (ADOX)!", vbExclamation, "Лидер Access"
' Удаление базы
If Dir(strmdb) "" Then Kill strmdb 'Уничтожаем старую базу данных
End Sub
'==============================================================
' DAO. Открытие базы данных
Private Sub butDAO_Click()
Dim dbs As DAO.Database, strmdb As String
' Определение файла
strmdb = Application.CurrentProject.Path "\temp.mdb" ' Путь базы
If Dir(strmdb) "" Then Kill strmdb 'Уничтожаем старую базу данных
' DAO. Открываем на чтение
DBEngine.CreateDatabase strmdb, dbLangCyrillic
MsgBox "База создана (DAO)!", vbExclamation, "Лидер Access"
' Удаление базы
If Dir(strmdb) "" Then Kill strmdb 'Уничтожаем старую базу данных
End Sub