Intitulé barre de programme

[dalbator]

Bonjour,

Je souhaite remplacer dans la barre de programme l'icone et "Microsoft Excel" par le nom de ma macro.

Quelqu'un à une idée de comment faire ???

Merci d'avance.

 

[Charly2]

Re : Intitulé barre de programme

Bonsoir dalbator, bonsoir à toutes et à tous,

Bien que je n'en voie pas trop l'utilité en ce qui concerne l'icône, voici des codes que tu peux utiliser :

1) pour modifier le titre, tiré d'un exemple de Frédéric Sigonneau sur Excelabo.net (clique sur Ce lien n'existe plus pour le lire) :

[FONT=Courier New][SIZE=1][COLOR=blue]Sub[/COLOR] ModifyApplicationName()
[COLOR=green]'[/COLOR]
[COLOR=blue]Const[/COLOR] NewName [COLOR=blue]As String[/COLOR] = "Ceci est mon application personnelle"
[COLOR=green]'[/COLOR]
  ActiveWindow.Name = ""
  Application.Caption = NewName
 
[COLOR=blue]End Sub[/COLOR][/SIZE][/FONT]

2) pour modifier ou restaurer l'icône d'Excel, un code de Orlando Magalhães Filho que tu peux retrouver sur le site de Ce site n'existe plus :

[FONT=Courier New][SIZE=1][COLOR=green]'Attribute VB_Name = "ChangeIconeExcel2"
 
'Changer l'icone d'Excel
'Orlando Magalhães Filho, mpep
'(Thanks to Bill Manville)[/COLOR]
 
[COLOR=blue]Declare Function[/COLOR] GetActiveWindow [COLOR=blue]Lib[/COLOR] "user32" () [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] GetFocus [COLOR=blue]Lib[/COLOR] "user32" () [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] GetWindowWord [COLOR=blue]Lib[/COLOR] "user32" _
                ([COLOR=blue]ByVal[/COLOR] hwnd [COLOR=blue]As Long, ByVal[/COLOR] nIndex [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Integer[/COLOR]
[COLOR=blue]Declare Function[/COLOR] SendMessage [COLOR=blue]Lib[/COLOR] "user32" [COLOR=blue]Alias[/COLOR] "SendMessageA" _
                ([COLOR=blue]ByVal[/COLOR] hwnd [COLOR=blue]As Long, ByVal[/COLOR] wMsg [COLOR=blue]As Long, _
                ByVal[/COLOR] wParam [COLOR=blue]As Integer, ByVal[/COLOR] lParam [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] FindWindow [COLOR=blue]Lib[/COLOR] "user32" [COLOR=blue]Alias[/COLOR] "FindWindowA" _
                ([COLOR=blue]ByVal[/COLOR] lpClassName [COLOR=blue]As String, ByVal[/COLOR] lpWindowName [COLOR=blue]As String[/COLOR]) [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] ExtractIcon [COLOR=blue]Lib[/COLOR] "Shell32.dll" [COLOR=blue]Alias[/COLOR] "ExtractIconA" _
                ([COLOR=blue]ByVal[/COLOR] hInst [COLOR=blue]As Long, ByVal[/COLOR] lpszExeFileName [COLOR=blue]As String, _
                ByVal[/COLOR] nIconIndex [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] DestroyIcon [COLOR=blue]Lib[/COLOR] "user32" ([COLOR=blue]ByVal[/COLOR] hIcon [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long[/COLOR]
[COLOR=blue]Declare Function[/COLOR] SetFocusAPI [COLOR=blue]Lib[/COLOR] "user32" [COLOR=blue]Alias[/COLOR] "SetFocus" ([COLOR=blue]ByVal[/COLOR] hwnd [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long[/COLOR]
[COLOR=green]'
' API Constants
'[/COLOR]
[COLOR=blue]Global Const[/COLOR] WM_SETICON = &H80
[COLOR=blue]Global Const[/COLOR] GWL_HINSTANCE = (-6)
[COLOR=blue]Global Const[/COLOR] GWL_STYLE = (-16)
[COLOR=blue]Global Const[/COLOR] WS_SYSMENU = &H80000
[COLOR=blue]Public Const[/COLOR] SM_CXICON = 11
[COLOR=blue]Public Const[/COLOR] SM_CYICON = 12
[COLOR=blue]Public Const[/COLOR] SM_CXSMICON = 49
[COLOR=blue]Public Const[/COLOR] SM_CYSMICON = 50
 
[COLOR=blue]Const[/COLOR] SW_SHOW = 5
[COLOR=green]'
' Various Windows Handles
'[/COLOR]
[COLOR=blue]Dim[/COLOR] hPreviousXLMAINBigIcon [COLOR=blue]As Long
Dim[/COLOR] hPreviousXLMAINSmallIcon [COLOR=blue]As Long
Dim[/COLOR] hPreviousEXCEL9BigIcon [COLOR=blue]As Long
Dim[/COLOR] hPreviousEXCEL9SmallIcon [COLOR=blue]As Long
Dim[/COLOR] hNewIcon [COLOR=blue]As Long
Dim[/COLOR] hInstanceExcel [COLOR=blue]As Integer
Dim[/COLOR] hWndXLMAIN [COLOR=blue]As Long
Dim[/COLOR] hWndEXCEL9 [COLOR=blue]As Long
 
Sub[/COLOR] SetPerceptorIcon()
    [COLOR=blue]Dim[/COLOR] theIconSource [COLOR=blue]As String
    Dim[/COLOR] theIconIndex [COLOR=blue]As Long
    Dim[/COLOR] istat [COLOR=blue]As Long[/COLOR]
 
    theIconSource = "C:\Windows\Winupd.ico" [COLOR=green]'ThisWorkbook.Path & "\Applicat.ico"
    ' can be any valid windows icon source(.EXE, .DLL, .ICO)[/COLOR]
 
    theIconIndex = 0
    [COLOR=green]' the index to the icon within the source
    ' If this index is 0, the ExtractIcon function
    ' returns the first icon in the source[/COLOR]
 
    istat = SetNewIcon(theIconSource, theIconIndex) [COLOR=green]' do the deed[/COLOR]
[COLOR=blue]End Sub[/COLOR]
 
[COLOR=green]'   A routine to change the standard Excel Icons[/COLOR]
[COLOR=blue]Function[/COLOR] SetNewIcon(theIconSource [COLOR=blue]As String[/COLOR], theIconIndex [COLOR=blue]As Long[/COLOR]) [COLOR=blue]As Long[/COLOR]
    [COLOR=blue]Dim[/COLOR] L [COLOR=blue]As Long[/COLOR]
    [COLOR=green]' Get handle to active window (Classname XLMAIN).[/COLOR]
    hWndXLMAIN = FindWindow("XLMAIN", Application.Caption)
    L = SetFocusAPI(hWndXLMAIN)
    hWndEXCEL9 = GetFocus()
    [COLOR=green]' Get the icon from the source[/COLOR]
    hNewIcon = ExtractIcon(0, theIconSource, 0)
    SetNewIcon = hNewIcon                       [COLOR=green]' return code from function[/COLOR]
    [COLOR=blue]If[/COLOR] hNewIcon = [COLOR=blue]Null Or[/COLOR] hNewIcon = 1 [COLOR=blue]Then[/COLOR]
        [COLOR=green]' 1 means invalid icon source, 0means no icons in source[/COLOR]
        MsgBox "icon not found"
        [COLOR=blue]GoTo[/COLOR] TidyUp
    [COLOR=blue]End If[/COLOR]
    hPreviousXLMAINBigIcon = SendMessage(hWndXLMAIN, WM_SETICON, 1, hNewIcon)   [COLOR=green]' Big Icon[/COLOR]
    hPreviousXLMAINSmallIcon = SendMessage(hWndXLMAIN, WM_SETICON, 0, hNewIcon) [COLOR=green]' Small Icon[/COLOR]
    hPreviousEXCEL9BigIcon = SendMessage(hWndEXCEL9, WM_SETICON, 1, hNewIcon)   [COLOR=green]' Big Icon[/COLOR]
    hPreviousEXCEL9SmallIcon = SendMessage(hWndEXCEL9, WM_SETICON, 0, hNewIcon) [COLOR=green]' Small Icon[/COLOR]
TidyUp:
[COLOR=blue]End Function[/COLOR]
[COLOR=green]'
'   A routine to restore the standard Excel Icons[/COLOR]
[COLOR=blue]Sub[/COLOR] restoreXLIcon()
    [COLOR=blue]Dim[/COLOR] hIcon [COLOR=blue]As Long
    Dim[/COLOR] lRetv [COLOR=blue]As Long[/COLOR]
 
    hIcon = SendMessage(hWndXLMAIN, WM_SETICON, True, hPreviousXLMAINBigIcon)    [COLOR=green]' restore Big Icon[/COLOR]
    hIcon = SendMessage(hWndXLMAIN, WM_SETICON, False, hPreviousXLMAINSmallIcon) [COLOR=green]' restore Small Icon[/COLOR]
    hIcon = SendMessage(hWndEXCEL9, WM_SETICON, True, hPreviousEXCEL9BigIcon)    [COLOR=green]' restore Big Icon[/COLOR]
    hIcon = SendMessage(hWndEXCEL9, WM_SETICON, False, hPreviousEXCEL9SmallIcon) [COLOR=green]' restore Small Icon[/COLOR]
    lRetv = DestroyIcon(hIcon)      [COLOR=green]' I think this is necessary to free
                                    'memory reserved in ExtractIcon[/COLOR]
 
[COLOR=blue]End Sub[/COLOR][/SIZE][/FONT]

J'ai conservé la mise en page trouvée sur le site de Frédéric.

Voilà de quoi t'occuper un bon moment :-D

A+ ;-)