access设置应用程序标题和图标的源码-任君行专栏

Function AddAppProperty(strName As String, _
varType As Variant, varvalue As Variant) As Integer
'应用程序标题和图标
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo AddProp_Err
dbs.Properties(strName) = varvalue
AddAppProperty = True
AddProp_Bye:
Exit Function
AddProp_Err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, varType, varvalue)
dbs.Properties.Append prp
Resume
Else
AddAppProperty = False
Resume AddProp_Bye
End If
End Function
----------------------------------------------------------------------------------------
Private Sub Form_Current()
Dim intX As Integer
Const DB_Text As Long = 25
'设置应用程序标题
intX = AddAppProperty("apptitle", DB_Text, xtmc)
'设置图标
intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\" & "30346.ico")
CurrentDb.Properties("UseAppIconForFrmRpt") = 1
Application.RefreshTitleBar
'回答问题2：这里请注意，如果你同时定义了 AppIcon 和 AppTitle，只要其中有一项是错误的，
'比如 AppIcon 的文件名或者路径错误，那么 RefreshTitleBar 就不会刷新标题。
End Sub