項目

起動時にアイコンを設定する

概要

[ツール]-[起動時の設定]で起動時の設定ダイアログで[アプリケーション アイコン]を設定しても、
環境が変わると当然表示されません。
いちいち設定するのが面倒なので実行するファイルと同一フォルダにアイコンを置いておき
起動時に設定するようにします。


'任意のアイコンを設定してください
Const ICON_NAME = "hoge.ico"

'*********************************************************************
'起動時に「SetIcon()」を呼び出してください
'*********************************************************************
Sub SetIcon()
    Const DB_Text   As Long = 10
    Dim currentpath As String
    Dim iconpath    As String
    Dim rt          As Integer
    
    'カレントパスの取得
    currentpath = CurrentProject.path
    
    If Right(currentpath, 1) <> "\" Then currentpath = currentpath & "\"
    
    'アイコンパス設定
    iconpath = currentpath & ICON_NAME
    
    'アイコンを設定
    rt = AddAppProperty("AppIcon", DB_Text, iconpath)
    Application.RefreshTitleBar

End Sub

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

起動時にアイコンを設定した例


メニューも非表示にしています。