Changer icone, titre et divers d'une appli sous excel

Commenter

Contenu du snippet

Il s'agit de montrer comment changer divers paramètres d'apparence d'une appli tournant sous excel mais où excel n'est plus apparent.
Le développement complet est sous VBA.
Le fichier excel complet est trop lourd pour être mis sur le site je mets donc le code du "This Workbook" si dessous .
Pour ce qui est des menus et le reste du code soit je l'envoie à qui me le demande, soit je le mets sur le site : en compressé 1.2 MO je ne sais pas si c'est possible.
L'image montre ce que l'on peut obtenir en sortie sur un projet réalisé...
jmluc@jmlucienvb.org

Source / Exemple : 


XXXXXDébut du rajout Icone
Const FichierIco As String = "Logo JML.ico"

Private Declare Function FindWindowA Lib "User32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetClassLongA Lib "User32" _
  (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetClassLongA Lib "User32" _
  (ByVal hWnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long

Private Declare Function LoadImageA Lib "User32" _
  (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

Dim HIcon As Long, hWnd As Long
'XXXX Fin de la première partie

Private Sub Workbook_Open()
    
    'XXXXXXXX Partie Icone
    Dim FIcone As String
    FIcone = Me.Path & "\" & FichierIco 'Chemin vers l'icone si elle est dans le répertoire
   
    If Dir$(FIcone) <> "" Then
    hWnd = FindWindowA(vbNullString, Application.Caption)
    HIcon = GetClassLongA(hWnd, -14)
    SetClassLongA hWnd, -14, LoadImageA(0, FIcone, 1, 0, 0, &H10)
    End If
    'XXXXXXXXX Fin partie icone
      
    
    'Interdiction du contrôle "X"
    Application.OnKey "^x", ""
    Application.OnKey "^v", ""
    
    Application.WindowState = xlNormal
    'Application.EnableEvents = False
    
    'Application.Width = 760
    'Application.Height = 480
    
    
    Call Mxx_A00_DisplayMainExcelFile
    
    'Paramétrage pour interdire la sortie
    final_end = False
    
    'Etat de la scroll verticale
    numberSCROLLROW = 1
        
    EtatDuFractionnement = False
    
    'Ouvrir toujours sur la feuille SYSAttente
    ActiveWorkbook.Sheets(11).Activate
    
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
'MsgBox "non"
 Cancel = True
End Sub

Private Sub Workbook_Deactivate()
    'Pour interdire une ouverture intempestive d'un autre fichier dans l'instance
    'Ce programme fait appel à deux APIs qui sont déclarées dans le module MAPIs_Declare
        
        On Error GoTo gestErr
    
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        
        Nom = ActiveWorkbook.Name
        FName = ActiveWorkbook.Path & "\" & Nom
        
        ActiveWorkbook.Close SaveChanges:=False
           
        FName = LongToShort(FName)
                        
        Tmp = ShellExecute(0, "open", "Excel.exe", FName, 0&, 1)
        Exit Sub
     End If
     
gestErr:
        If Err.Number = 0 Or Err.Number = 91 Then Exit Sub
        
        MsgBox Err.Number
                   
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Application.EnableEvents = True
    
    If final_end Then
        
        'XXXXX Partie Icone
        If HIcon Then
            SetClassLongA hWnd, -14, HIcon
        End If
        'XXXXX Fin partie icone
        
    'A réactiver pour test
    Call fin
    Else
    
    Cancel = True
    
    'ActiveWorkbook.Sheets(11).Activate
    Application.WindowState = xlMinimized
      
    
    End If
    
End Sub

Conclusion :


n'hésitez pas à me contacter pour plus amples infos
jmlucienvb

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.