Программирование на Visual Basic | Microsoft Access, Excel, Word

В этом разделе сайта находятся примеры из сборника программ "Архив файлов на Microsoft Access". В нем рассказывается о программировании форм, отчетов, таблиц и других объектов. Используйте этот архив для изучения работы с приложением Microsoft Office Access и программированием на Visual Basic for Application. Тем кто уже знаком с VBA, используйте поиск для нахождения кодов. Наберите, например, DAO, ADO, Recordset и найдете нужную ссылку для решения проблемы с программированием

Microsoft Access. Как изменить размер поля в таблице

02. Использование ALTER COLUMN в запросе SQL решит эту проблему

Private Sub butExecute_Click()
Dim dbs As Database
    On Error GoTo 999
        CurrentDb.Execute _
           "ALTER TABLE [Пример 01] ALTER COLUMN [Описание] TEXT(" _
            Me.fldSize  ")"
        MsgBox "Размер поля в таблице 'Примеры 01': "  vbCrLf  _
        Me.fldSize  " символов(а)", vbInformation, "Изменение поля"
    Exit Sub
999:
    MsgBox Err.Description, vbCritical, "Изменение поля"
    Err.Clear
End Sub

Microsoft Access. Суммирование поля в отчете

13. Это делается в конструкторе отчета, смотрите пример файла mdb

'12. Печать на нескольких принтерах
Private Sub Example12_Click()
    On Error GoTo 999 'Выход по ошибке
    While (1) 'Назначаем бесконечный цикл
        DoCmd.SelectObject acReport, "Пример 12", True 'Выбираем отчет в БД
        DoCmd.RunCommand acCmdPrint 'Вызываем печать
    Wend
999:
    Err.Clear 'Очищаем ошибку при отмене печати
    DoCmd.SelectObject acForm, Me.Name  'Выбираем форму
End Sub

Microsoft Access. Создание своего счетчика в таблицах

13. В этом примере написано, как можно создать собственный счетчик, если вы используете форму для редактирования записей. Это не есть полное решение задачи, т.к. в таблицу Access нельзя добавить собственную функцию. У SQL Server это можно сделать. Он также позволяет и переименовать данные счетчика, в Access это не получится. Суть алгоритма: используем событие текущей записи и присваиваем новое значение событию по умолчанию. Таким образом, если пользователь будет находится в новой записи, данные не будут добавлены.

' Получение счетчика записей
Private Sub Form_Current()
    If Me.NewRecord = True Then
        Me.MyNumber.DefaultValue = Nz(DMax("MyNumber", "Пример 13", ""), 0) + 1
    End If
End Sub

Microsoft Access. Создание собственных массивов

02. Используя оператор Type, можно создать собственный массив данных. Например, линий

Type colorLINE 'назначаем тип объекта
   x1 As Long 'Абцисса начала
   y1 As Long 'Ордината начала
   x2 As Long 'Абцисса конца
   y2 As Long 'Ордината конца
   color As Long 'Цвет линии
   '... Здесь Вы можете добавить любые объекты, переменные и т.п.
End Type

Dim myLine(2) As colorLINE 'выделяем массив для линий

'==============================================================
'   Заполнение массива
Public Function funArrayLines(frm As Form)
Dim i As Integer
    For i = 0 To 1
        Select Case i
            Case 0 'Горизонтальная линия
               myLine(i).x2 = 100
               myLine(i).color = RGB(255, 0, 0) 'Красный цвет
               frm.Линия1.BorderColor = myLine(i).color 'Меняем цвет линии
            Case 1 'Вертикальная линия
               myLine(i).y2 = 100
               myLine(i).color = RGB(0, 255, 0) 'Зеленый цвет
               frm.Линия2.BorderColor = myLine(i).color 'Меняем цвет линии
        End Select
    Next i
End Function

Microsoft Access. Загрузка файлов bmp из каталога

01. Данный пример показывает вам, как можно загрузить все рисунки из каталога в базу данных. Обратите внимание на Dir("\*.bmp", vbNormal) - таким простейшим и древним способом можно получить все файлы из каталога. Рекомендации для хранения рисунков. Лучше использовать отдельные файлы, хотя в некоторых случаях это может пригодится.

'    Загрузить рисунки из файла в таблицу
'    (Для работы программы в папке должны быть файлы *.bmp)
'
Private Sub butExecute_Click()
Dim myBmp As String, myDir As String
On Error GoTo 999
    ' Папка для поиска
    myDir = Application.CurrentProject.Path
    ' Находим файл с расширением bmp
    myBmp = Dir(myDir  "\*.bmp", vbNormal)
    Do While Len(myBmp)  0 'Проверяем файл
        Me.Файл = myBmp  'Файл bmp
        Me.Папка = myDir 'Каталог
        Me.Рисунок.OLETypeAllowed = acOLEEmbedded 'Назначаем режим вставки
        Me.Рисунок.SourceDoc = Me.Папка  "\"  Me.Файл 'Путь файла
        Me.Рисунок.Action = acOLECreateEmbed 'Вставляем объект в таблицу
        'Переход к новой записи
        myBmp = Dir  'Новый файл bmp
        DoCmd.RunCommand acCmdRecordsGoToNew ' Переходим на новую запись
    Loop
    DoCmd.RunCommand acCmdRecordsGoToFirst 'Начало записей
    MsgBox "Рисунки загружены!", vbExclamation, "Графика"
    Exit Sub
999:
    MsgBox Err.Description  'Ошибка
    Err.Clear
End Sub

Microsoft Access. Диспетчер связанных таблиц

18. Если у Вас интерфейс хранится в одной базе, а данные в другой, то необходимо научится привязывать базу к таблицам на сервере. Иначе пользователю, используя стандартный интерфейс будет очень трудно это сделать. В этом примере показано как это делается автоматически через программный код.

Private Sub Form_Open(Cancel As Integer)
Dim s As String, tdf As TableDef, dbs As Database
Dim tdfName As String, dbsName As String, i As Integer
    On Error GoTo 999
    Set dbs = CurrentDb 'Выбор базы данных
    dbs.Execute "DELETE * FROM [Пример 18]" 'Удаляем все записи
    'Инициализация таймера загрузки
    Application.SetOption "Строка состояния", True 'Показываем строку
    i = 1: SysCmd acSysCmdInitMeter, "Загрузка таблиц ...", dbs.TableDefs.Count
    For Each tdf In dbs.TableDefs   'Просматриваем все таблицы
        SysCmd acSysCmdUpdateMeter, i: i = i + 1 'Перерисовываем таймер
        dbsName = funGetSubString(tdf.Connect, ";DATABASE=", ";") 'Находим связанную таблицу
        If (dbsName  "") Then
            tdfName = tdf.Name 'Имя таблицы
            'Составляем запрос на добавление
            s = "INSERT INTO [Пример 18] ( Вкл, Таблица, Файл ) SELECT "  _
                "False AS Вкл, """  _
                tdfName  """ AS Таблица,"""  _
                dbsName  """ AS Файл;"
            dbs.Execute s 'Добавляем в таблицу меню
        End If
    Next
    SysCmd acSysCmdRemoveMeter 'Удаляем таймер
    Me.Requery 'Изменяем запрос в форме
    Exit Sub
999:
    SysCmd acSysCmdRemoveMeter 'Удаляем таймер
    MsgBox Err.Description 'Сообщаем об ошибке
    Err.Clear
End Sub

Microsoft Access. Округление полей в форме

20. Для округления математических полей в форме можно использовать функцию формат. 

Private Sub Form_Open(Cancel As Integer)
    Me.myFormat = "0.00"
    Me.myИтого = Format(Me.myNumber, Me.myFormat)
End Sub

Microsoft Access. Связывание табличных форм

24. Если у вас в форме используется несколько таблиц, то связать их можно с помощью этого программного кода

Public Sub Form_Current()
    On Error GoTo 999
    With Me.Parent.Пример_24_2.Form
        .Filter = "Код="  Me.Код
        .FilterOn = True
    End With
    Exit Sub
999:
    Err.Clear
End Sub

Microsoft Access. Смена источника данных

21. Это достаточно гибкий способ менять источник данных в вашей форме. Он не использует строковые переменные, а применяет ключевое слово set для запроса данных из DAO или ADO.

Private Sub Form_Open(Cancel As Integer)
    Me.Дата = DateSerial(2005, 9, 20)
    butDAOrecordset_Click
End Sub

Private Sub Дата_AfterUpdate()
    butDAOrecordset_Click
End Sub

Private Sub butADOrecordset_Click()
Dim rst As ADODB.Recordset
    ' Создание запроса
    Set rst = New ADODB.Recordset
    ' Заполняем запрос
    With rst
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "[Мои книги]"
        .Open , CurrentProject.Connection, , , adCmdTable
    End With
    Set Me.subForm.Form.Recordset = rst
End Sub
   
Private Sub butDAOrecordset_Click()
Dim strParm As String, strSQL As String
Dim qry As DAO.QueryDef, dbs As DAO.Database
    Set dbs = CurrentDb
    Set qry = dbs.QueryDefs("qryExample22")
    qry.Parameters("paramДата") = Nz(Me.Дата, Date)
    Set Me.subForm.Form.Recordset = qry.OpenRecordset
'    strParm = "PARAMETERS [paramДата] DATETIME; "
'    strSQL = strParm  "SELECT * FROM [Мои книги] WHERE [Дата]=[paramДата]"
'    Me.Список.Form.InputParameters = "paramДата DateTime=#09/20/2000#"
End Sub