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
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.