Программирование на Visual Basic | Все записи admin

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

Microsoft Access. Добавление рисунков в отчет

07. 2 примера, один добавление из таблицы, а другой из файла показывают как можно внести в отчет логотипы и т.п.

' Из файла
Private Sub ОбластьДанных_Format(Cancel As Integer, FormatCount As Integer)
    Me.picFromFile.Picture = Application.CurrentProject.Path  _
                 "\"  Me.Рисунок
End Sub

'  Вставить рисунок из таблицы sTable
Private Sub InsertPicture(ctrl As Control, sTable As String)
Dim dbs As Database, rst As Recordset
    On Error GoTo 999 'Обработка ошибки
    Set dbs = CurrentDb 'Текущая база данных
    Set rst = dbs.OpenRecordset(sTable) 'Открываем таблицу
    If rst.RecordCount  0 Then
        rst.MoveLast  'Заполняем запрос
        rst.MoveFirst 'Устанавливаем позицию
        ctrl.Picture = Application.CurrentProject.Path  _
                 "\"  rst!Рисунок  'Полное имя файла
    End If
    rst.Close
999:
    Err.Clear 'Сброс ошибки
End Sub

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. Раccкрашивание таблиц

19. Таблицу в подчиненной форме невозможно раскрасить простым способом, для этого надо знать некоторые хитрости. Посмотрите этот пример.

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
    'Назначаем цвет для всей таблицы
    Me.DatasheetBackColor = RGB(180, 210, 180)
    
    'Назначим в поле 'Дата' такое форматирование, чтобы
    'выделить дату = 20 сентября 2000 года
    With Me.Дата
        .FormatConditions.Delete 'Удаляем все условия
        'Назначение форматирования
        .FormatConditions.Add acFieldValue, acEqual, "#09/20/2000#"
        'Изменение цвета ячейки
        With .FormatConditions(0)
           .BackColor = 13434828 'Цвет фона
           .FontBold = True 'Толщина букв
           .ForeColor = RGB(255, 0, 0) 'Цвет символов - красный
        End With
    End With
    'Назначим в поле 'Книга' такое форматирование, при котором
    'будут отображаться строки с полем Сумма  30 рублей
    With Me.Книга
        .FormatConditions.Delete 'Удаляем все условия
        .FormatConditions.Add acExpression, , "[Сумма]30" 'выражение
        .FormatConditions(0).BackColor = 12632256 'Серый цвет фона
    End With
    
    'Назначим в поле 'Сумма' такое форматирование, при котором
    'при входе в поле будет меняться цвет символов
    With Me.Сумма
        .FormatConditions.Delete 'Удаляем все условия
        .FormatConditions.Add acFieldHasFocus 'Назначаем фокус
        .FormatConditions(0).ForeColor = RGB(0, 0, 255) 'Синий цвет
        .FormatConditions.Add acFieldValue, acBetween, "200", "500"
        .FormatConditions(1).ForeColor = 255
    End With
    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. Смена источника данных

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