Change application title and icon via VBA? 1

[VictoryHighway]

Hello,
Is there a way to change the main application title and icon (from the Startup dialog box) via VBA, so that when a user makes a certain choice, the icon and title are changed? I tried looking at the "application" method, but there wasn't an icon, caption or title property that I could work with. Does anyone have any suggestions? By the way, I am working with Access 2k. Thanks.

--Geoffrey

 

[BobStubbs]

You can get to the application name and icon properties like this:

CurrentDb.Properties("AppIcon")

CurrentDb.Properties("AppTitle")

To see this, try typing:

debug.print CurrentDb.Properties("AppTitle")

into the Immediate window.

I created some sample code in the click event of a test button:

Private Sub btnTest1_Click()

CurrentDb.Properties("AppTitle") = "My New Title"

End Sub

However, this change does not take effect until you close and re-open the database. My guess is that these variables are read into memory when the database opens - maybe someone else knows how to reset them in 'real time'?

By the way, you can see a full Properties list for your database by pasting this code into a module, and running it while the Immediate window is open:

Sub ListDatabaseProperties()

Dim I As Integer

On Local Error Resume Next

For I = 1 To CurrentDb.Properties.Count
    Debug.Print CStr(I), CurrentDb.Properties(I).Name, CurrentDb.Properties(I)
Next I
End Sub

I hope that this is of some help.


Bob Stubbs

 

[VictoryHighway]

Hmm. That's not quite what I wanted to do. I'd like to have an initial startup application title and icon and then change both when a user makes a choice on a startup form. I would prefer that this happen during the current database session.

 

[VictoryHighway]

Anyone have any ideas?

 

[oharab]

This function will let you change your Icon

Option Compare Database
Option Explicit

Private Declare Function LoadImage Lib "user32" _
                                   Alias "LoadImageA" _
                                   (ByVal hinst As Long, _
                                    ByVal lpsz As String, _
                                    ByVal un1 As Long, _
                                    ByVal n1 As Long, _
                                    ByVal n2 As Long, _
                                    ByVal un2 As Long) _
                                   As Long

Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) _
                                     As Long

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

'---------------------------------------------------------------------------------------
' Procedure : SetFormIcon
' DateTime  : 03/02/2004 15:04
' Author    : Ben O'Hara (bpo@robotparade.co.uk)
' Purpose   : Adds custom icon to forms control box
'---------------------------------------------------------------------------------------
'
Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
    Dim lIcon As Long
    Dim lResult As Long
    Dim x As Long, Y As Long

10  On Error GoTo SetFormIcon_Error

20  x = GetSystemMetrics(SM_CXSMICON)
30  Y = GetSystemMetrics(SM_CYSMICON)
40  lIcon = LoadImage(0, strIconPath, 1, x, Y, LR_LOADFROMFILE)
50  lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

SetFormIcon_Exit:
60  On Error Resume Next
70  Exit Function

SetFormIcon_Error:
80  Select Case Err.Number
        Case Else
90          MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SetFormIcon of Module mdlSetIcon at Line " & Erl()
100 End Select

110 Resume SetFormIcon_Exit
End Function

It's designed for forms, but will work on the whole app (and even other apps if you know the hwnd)

To use it on the application:

SetFormIcon Application.hWndAccessApp ,"W:\VRS\vrs.ico"

on a form a put it on the onOpen event

SetFormIcon me.hWnd ,"W:\VRS\vrs.ico"

or you can set a forms Icon

SetFormIcon forms!frmYouWantToChange.Form.hWnd ,"W:\VRS\vrs.ico"

To change your Application title text try this:

Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long


Sub SetAppWindowText(strText As String)
      Dim rval As Long
10       On Error GoTo SetAppWindowText_Error

20    rval = SetWindowText(Application.hWndAccessApp, strText)
30    If rval <> 1 Then Err.Raise vbObjectError + 512, "SetAppWindowText", "Error Calling Dll"

SetAppWindowText_Exit:
40       On Error Resume Next
50       Exit Sub

SetAppWindowText_Error:
60        Select Case Err
              Case Else
70                MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SetAppWindowText of Module mdlSetIcon at line " & Erl(), vbOKOnly, Application.Name
80            Resume SetAppWindowText_Exit
90        End Select
100       Resume 'useful for debugging. Right click on here and tell VBA to resume execution at that line.  You will then be returned to the line which caused the error.


End Sub

and pass it your required text

SetAppWindowText "Bob"

hth

Ben

----------------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

"Where are all the stupid people from...
...And how'd they get so dumb?"

NoFX-The Decline
----------------------------------------------
Want to get great answers to your Tek-Tips questions? Have a look at F

 

[VictoryHighway]

Ben,
I'll give that a try. Thanks.

--Geoffrey

 

[VictoryHighway]

Ben,
Five stars! Thanks! That works great.

--Geoffrey