5 строк кода

Что бы поменять стандартную иконку MS Access на что-нибудь свое необходимо открыть окно параметры запуска приложения и указывать там путь к изображению. Заодно можно поменять его руками. Естественно этот параметр можно задавать программно см. имена и значения коллекции CurrentDb.Parametrs.

Для изменения параметров из коллекций типа CurrentDb.Parametrs я написал функцию VC_PropertyChange(), которая располагается в модуле mc_objects.

Dim stAppTitle as String
dim stPathToIco as String

'-- изменить название приложения
Call mc_objects.VC_PropertyChange(CurrentDb, "AppTitle", dbText, stAppTitle)
'-- изменить иконку по умолчанию
Call mc_objects.VC_PropertyChange(CurrentDb, "AppIcon", dbText, stPathToIco)
Call mc_objects.VC_PropertyChange(CurrentDb, "UseAppIconForFrmRpt", dbBoolean, True)
'-- отобразить изменения
Application.RefreshTitleBar

Также в модуле mc_objects располагается еще одна полезная функция VC_PropertyValue(), которая читает значения параметра:

Dim stMenu As String
'-- получить меню по умолчанию
stMenu = VC_PropertyValue(CurrentDb, "StartUpMenuBar")

Текст функций:

Public Sub CM_PropertyChange(ByRef obj As Object _
                                , ByVal imProperty As String _
                                , ByVal vPropertyType As Variant _
                                , ByVal vPropertyValue As Variant)
' 2007-03-17 Скоков С.А.
' Изменить свойства (Properties) объекта. Если свойства нет, то оно добавляется.
On Error GoTo Err_
    Dim prp As DAO.Property
    Const c_ErrorPropNotFound = 3270

    obj.Properties(imProperty) = vPropertyValue
    CM_PropertyChange = True

Exit_:
    Exit Sub

Err_:
    If Err.Number = c_ErrorPropNotFound Then     '-- Property not found.
        Set prp = obj.CreateProperty(imProperty, vPropertyType, vPropertyValue)
        obj.Properties.Append prp
        Resume Next
    Else '-- Unknown error.
	Err.Raise vbObjectError + 1, "CM_PropertyChange()->" & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub

Public Function CM_PropertyValue(ByRef obj As Object _
                                , ByVal imProperty As String) As Variant
' 2007-03-17 Скоков С.А.
' Изменить свойства (Properties) объекта. Если свойства нет, то оно добавляется.
On Error GoTo Err_
    Dim prp As DAO.Property
    Const c_ErrorPropNotFound = 3270

    Set prp = obj.Properties(imProperty)

    CM_PropertyValue = prp.Value

Exit_:
    Exit Function

Err_:
    If Err.Number = c_ErrorPropNotFound Then     '-- Property not found.
    Else '-- Unknown error.
        Err.Raise vbObjectError + 1, "CM_PropertyValue()->" & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Function

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.