|
|
Установка Заголовока окна приложения и Иконки
Private Sub Test_App_Icon_and_Title()
Dim str As String
Dim i As Integer
On Error Resume Next
str = CurrentProject.Path & "\Application.ico"
AddAppProperty "AppIcon", dbText, str
Application.RefreshTitleBar
Err.Clear
str = "Пример НАЗВАНИЕ"
i = AddAppProperty("AppTitle", dbText, str)
Application.RefreshTitleBar
End Sub
Private Function AddAppProperty(strName As String, vType As Variant, vVal As Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
On Error GoTo AddAppPropertyErr
Set dbs = CurrentDb
dbs.Properties(strName) = vVal
AddAppProperty = True
AddAppPropertyBye:
Exit Function
AddAppPropertyErr:
If Err.Number = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, vType, val)
dbs.Properties.Append prp
Else
AddAppProperty = False
MsgBox Err
End If
Err.Clear
Resume AddAppPropertyBye
End Function
|
|