MS Access - полезные решения

[Valery]

1. Создать общий модуль (или в уже имеющийся) добавить функцию:

Код: Выделить всё

Public Sub SetFieldColor(ctrl As Control)
    Dim value As Integer
    value = ctrl.Value ' Получаем значение из переданного поля

    Select Case value
        Case 0
            ctrl.BackColor = RGB(255, 255, 255) ' Белый
        Case 1
            ctrl.BackColor = RGB(0, 255, 255) ' Бирюзовый
        Case 2
            ctrl.BackColor = RGB(102, 255, 0) ' Зеленый
        Case 3
            ctrl.BackColor = RGB(255, 255, 0) ' Желтый
        Case 4
            ctrl.BackColor = RGB(255, 0, 255) ' Маджента
        Case 5
            ctrl.BackColor = RGB(75, 0, 130) ' Индиго
        Case Else
            ctrl.BackColor = RGB(255, 0, 0) ' Красный
    End Select  
End Sub

2. В форме вызовываем эту функцию и передаем ей нужные поля. Напр. При загрузке формы (Form_Load):

Код: Выделить всё

Private Sub Form_Load()
    'Поле file_set
    Call SetFieldColor(Me.file_set)
     'Поле другое_поле
    Call SetFieldColor(Me.другое_поле)
End Sub

3. В поле - После обновления значений в полях (AfterUpdate):

Код: Выделить всё

Private Sub file_set_AfterUpdate()
    Call SetFieldColor(Me.file_set)
End Sub

Private Sub another_field_AfterUpdate()
    Call SetFieldColor(Me.другое_поле)
End Sub

Чтобы цвет поля менялся при переходе между записями в форме, нужно добавить вызов функции SetFieldColor в событие Form_Current. Это событие срабатывает каждый раз, когда активная запись изменяется:

Код: Выделить всё

Private Sub Form_Current()
    Call SetFieldColor(Me.file_set)
    'Call SetFieldColor(Me.другое_поле)
End Sub

[Valery]

Смена цвета ячейки в зависимости от значения.
Конструктор формы - контекстное меню поля, Условное форматирование:

Условное форматирование MS Access

Воскресенье выделить:

Код: Выделить всё

Weekday([НазваниеПоля]) = 1

Но тут можно использовать только 3 значения.

---

Если надо красить форму больше чем 3 цвета, в свойствах формы Текущая запись - Процедура обработки событий...

Код: Выделить всё

Private Sub SetFieldColor()
    'Изменение цвета формы в зависимости от значения поля
    Dim value As Integer
    
    value = Me.file_set.value 'Название поля формы
    
    Select Case value
        Case 0
            Me.file_set.BackColor = RGB(255, 255, 255) ' Белый
        Case 1
            Me.file_set.BackColor = RGB(0, 255, 255) ' Бирюзовый
        Case 2
            Me.file_set.BackColor = RGB(0, 128, 0) ' Зеленый
        Case 3
            Me.file_set.BackColor = RGB(255, 255, 0) ' Желтый
        Case 4
            Me.file_set.BackColor = RGB(255, 0, 255) ' Маджента
        Case 5
            Me.file_set.BackColor = RGB(75, 0, 130) ' Индиго
        Case Else
            Me.file_set.BackColor = RGB(255, 0, 0) ' Белый по умолчанию
    End Select
End Sub

[Valery]

Обращения к элементам в Access:

Описание	Пример
Все	Me.Requery
Данные	Me.RecordSource=Me.RecordSource
КонтролыФормы	Me.ИмяПодчФормы.Form.Refresh
ПодчФорму	Me.ИмяПодчФормы.Form.Requery
Форму	Forms!ИмяФормы.Refresh
Формы	DoCmd.RunCommand acCmdRefresh
Элемент	Me.Элемент.Requery
Конкретный элемент другой формы	Forms![НужнаяФорма]![ПолеДляОбновления].Requery

Код: Выделить всё

Forms![Счета - подробности оплат]![Счет] 

[Valery]

Расположена внизу окна MS Access.

Сервис -> Параметры запуска... -> галка на Строка состояния

[Valery]

MS Access - открытие ссылки в стандартном браузере при двойном клике в поле.

Значение поле получает так:

Код: Выделить всё

=DLookUp("[link]";"[links]";"[id] = [links_id_viev_code]")

Двойное нажатие кнопки:

Код: Выделить всё

Private Sub group_url_DblClick(Cancel As Integer)
    Dim strUrl As String
    strUrl = Me.group_url
    If Not IsNull(strUrl) And strUrl <> "" Then
        ' Команда Shell для открытия URL в стандартном браузере
        Call Shell("cmd.exe /c start " & strUrl, vbHide)
    End If
End Sub

[Valery]

При закрытии формы проверить - открыта ли FORM2 и если открыта закрыть FORM2:

Код: Выделить всё

Private Sub Form_Close()
    Dim frm As Object
    On Error Resume Next
    Set frm = Forms("FORM2")

    If Not frm Is Nothing Then
        DoCmd.Close acForm, "FORM2"
    End If

    Set frm = Nothing
End Sub

[Valery]

MS Access - открыть папку в FastStone Image Viewer:

Код: Выделить всё

Private Sub folder_hdd_DblClick(Cancel As Integer)
    Dim folderPath As String
    Dim programPath As String
    
    'Открыть папку
    folderPath = Me.folder_hdd
    
    'Путь к программе
    programPath = "C:\Program Files (x86)\FastStone Image Viewer\FSViewer.exe"
    
    If Dir(folderPath, vbDirectory) <> "" Then
        Shell Chr(34) & programPath & Chr(34) & " " & Chr(34) & folderPath & Chr(34), vbNormalFocus
    Else
        MsgBox "Папка не найдена: " & folderPath, vbExclamation
    End If
End Sub

[Valery]

Выбрать максимальное значение из уже выведенных значений в поле sort формы ppgallery_line: пройтись по всем записям формы и найти максимальное значение.
Вот кода, который это делает:

Код: Выделить всё

Private Sub sort_DblClick(Cancel As Integer)
    On Error GoTo ErrorHandler ' Обработка ошибок

Dim maxSort As Long
    Dim rst As DAO.Recordset

    Set rst = Me.RecordsetClone ' Клонируем текущий набор записей формы
    rst.MoveFirst ' Переходим к первой записи
    
    Do While Not rst.EOF
        If Nz(rst!sort, 0) > maxSort Then
            maxSort = rst!sort
        End If
        rst.MoveNext
    Loop

Me!sort = maxSort + 1 ' Установить значение на +1 большее из имеющихся
    Set rst = Nothing ' Очистка объекта Recordset

Exit Sub

ErrorHandler:
    MsgBox "Ошибка: " & Err.Description, vbExclamation
End Sub

[Valery]

photosession-info - форма
photosession_select элемент со списком

Код: Выделить всё

Private Sub photosession_select_AfterUpdate()
     ' Find the record that matches the control.
     Dim rs As Object

 Set rs = Me.Recordset.Clone
     rs.FindFirst "[id] = " & str(Nz(Me![photosession_select], 0))
     If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub

[Valery]

VBA код копирует в буфер обмена значения из указанных полей text text_min tags с двумя переводами строки между ними:

Код: Выделить всё

Dim DataObj As Object
Set DataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

Dim clipboardText As String

' Собираем значения из указанных полей с двумя переводами строки между ними
clipboardText = Me.text.Value & vbCrLf & vbCrLf & _
                Me.text_min.Value & vbCrLf & vbCrLf & _
                Me.tags.Value

' Удаляем последний символ новой строки, если необходимо
If Len(clipboardText) > 0 Then
    clipboardText = Left(clipboardText, Len(clipboardText) - 1)
End If

' Копируем текст в буфер обмена
DataObj.SetText clipboardText
DataObj.PutInClipboard