Программирование на Visual Basic | Microsoft Access. Как изменить цвет некоторых полей в запросе

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

Microsoft Access. Как изменить цвет некоторых полей в запросе

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

'==============================================================
'   Установить формат поля
Private Sub butExecute_Click()
Dim dbs As Database, obj As Object
    On Error GoTo 999
        Set dbs = CurrentDb
        Set obj = dbs.QueryDefs("Запрос 03").Fields("Сумма03")
        SetFieldProperty obj, "Format", dbChar, "0.00;0.00;0.00;0[Red]"
    Exit Sub
999:
    MsgBox Err.Description, vbCritical, "Изменение поля"
    Err.Clear
End Sub

'==============================================================
'   Удалить формат поля
Private Sub butDelProp_Click()
Dim dbs As Database, obj As Object
    On Error GoTo 999
        Set dbs = CurrentDb
        Set obj = dbs.QueryDefs("Запрос 03").Fields("Сумма03")
        SetFieldProperty obj, "Format", dbChar, "0;0;0"
    Exit Sub
999:
    MsgBox Err.Description, vbCritical, "Удаление поля"
    Err.Clear
End Sub

'==============================================================
'   Установить свойство поля запроса
Private Sub SetFieldProperty(obj As Object, _
        prpName As String, _
        prpType As Integer, _
        prpValue As Variant)
Dim prp As Variant
    On Error GoTo 999
    obj.Properties(prpName) = prpValue
    obj.Properties.Refresh
    MsgBox "Свойство изменено!", vbExclamation, "Свойства"
    Exit Sub
999:
    Err.Clear
    Set prp = obj.CreateProperty(prpName, prpType, prpValue)
    obj.Properties.Append prp
    obj.Properties.Refresh
End Sub

Добавить комментарий

Loading