CHANGER ICONE, TITRE ET DIVERS D'UNE APPLI SOUS EXCEL

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