Bonjour,
Je viens de créer un programme de gestion sur excel mais je passe des heures sur heures à chercher mais en vain:
Voici ma préoccupation ; c'est que je veux qu'à l'ouverture de mon programme l'utilisateur soit amené à activer les macros sans quoi que seulement la page "Blocage" soit visible et toutes les autres soient invisibles;Et si les macros sont activées ,que mon classeur s'ouvre toujours sur la page "Acceuil".
j'ai essayé les solutions proposées à partir du net et j'ai obtenu ce code mais ça ne fonctionne pas:
1)A la fermerture du classeur,un message d'erreur s'affiche: "Erreur définie par l'application ou par l'objet "
2)A l'ouverture du classeur:
-une autre erreur:"Erreur d'exécution'9' l'indice n'appartient pas à la sélection"
-que les macros soient activées ou pas la page "Blocage" reste invisible
Et toutes les autres feuilles restent toujours visibles.
-En plus une des feuilles ("Plan_comptable_liste") que j'avais masquée devient visible et n'est donc plus masquée.
Voici le code en question:
Je précise que j'ai un bouton qui me permet de quitter le classeur et voici la macro qui lui est lié
Les gars soyez indulgents car je suis débutant, Entre temps j'ai aussi cherché sur le net et à travers ce forum ;j'ai eu des codes intéressants mais ils ne fonctionnent pas avec mon code(ou du moins je n'arrive pas à les integrer à mon code);c'est pourqoui je me tourne vers vous vous etes mon seul espoir .
Si quelqu'un pouvait se pencher sur mon cas;merci d'avance
Je viens de créer un programme de gestion sur excel mais je passe des heures sur heures à chercher mais en vain:
Voici ma préoccupation ; c'est que je veux qu'à l'ouverture de mon programme l'utilisateur soit amené à activer les macros sans quoi que seulement la page "Blocage" soit visible et toutes les autres soient invisibles;Et si les macros sont activées ,que mon classeur s'ouvre toujours sur la page "Acceuil".
j'ai essayé les solutions proposées à partir du net et j'ai obtenu ce code mais ça ne fonctionne pas:
1)A la fermerture du classeur,un message d'erreur s'affiche: "Erreur définie par l'application ou par l'objet "
2)A l'ouverture du classeur:
-une autre erreur:"Erreur d'exécution'9' l'indice n'appartient pas à la sélection"
-que les macros soient activées ou pas la page "Blocage" reste invisible
Et toutes les autres feuilles restent toujours visibles.
-En plus une des feuilles ("Plan_comptable_liste") que j'avais masquée devient visible et n'est donc plus masquée.
Voici le code en question:
Code:
'Déclaration à mettre dans un Module
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, ByRef lpVolumeSerialNumber As Long, ByRef lpMaximumComponentLength As Long, ByRef lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not flag Then Cancel = True
End Sub
'Fin des Déclarations
Private Sub Workbook_Open()
Application.Caption = "Nom Produit"
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$
'Disque à checker
PathName$ = "c:\"
rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
'Afficher le résultat dans des msgbox
If DrvSerialNo$ = "N° DD" Then
MsgBox " Bienvenu(e) dans votre programme de gestion "
Dim FeuilleActive As String
FeuilleActive = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("Accueil").Activate
ThisWorkbook.Save
Sheets(FeuilleActive).Activate
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
Else
Application.Run "SupprimeFeuille"
End If
End Sub
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long
DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)
r& = GetVolumeInformation(PathName$, DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))
If r& = 0 Then Exit Sub
'determine le label
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(pas de label)"
'determine l'id du disque
HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub
Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else: GetHiWord% = dw& \ 65535
End If
End Function
Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else: GetLoWord% = dw& And &HFFFF&
End If
End Function
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then Cancel = True
Dim FeuilleActive As String, Feuille As Worksheet
FeuilleActive = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("Blocage").Visible = True
Sheets("Blocage").Activate
For Each Feuille In ThisWorkbook.Sheets
If Feuille.Name <> "Blocage" Then Feuille.Visible = False
Next Feuille
ThisWorkbook.Save
For Each Feuille In ThisWorkbook.Sheets
Feuille.Visible = True
Next Feuille
Sheets(FeuilleActive).Activate
Sheets("Blocage").Visible = False
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
Code:
'Callback for Quitter onAction
' Déclaration à mettre dans un Module
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, ByRef lpVolumeSerialNumber As Long, ByRef lpMaximumComponentLength As Long, ByRef lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'Fin des Déclarations
Sub Exit1(control As IRibbonControl)
flag = True
Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$
'Disque à checker
PathName$ = "c:\"
rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
'Afficher le résultat dans des msgbox
If DrvSerialNo$ = "C6DB-4342" Then
If MsgBox("Voulez vous vraiment quitter Gescofis?", vbYesNo + vbQuestion, "PCE Devxl & Consulting") = vbNo Then
Exit Sub
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Else
MsgBox (" A défaut de licence acquise , votre programme de gestion ne fonctionnera plus !"), vbYesNo = 1, "Nom Produit"
Application.Run "SupprimeFeuille"
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
End Sub
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long
DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)
r& = GetVolumeInformation(PathName$, DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))
If r& = 0 Then Exit Sub
'determine le label
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(pas de label)"
'determine l'id du disque
HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub
Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else: GetHiWord% = dw& \ 65535
End If
End Function
Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else: GetLoWord% = dw& And &HFFFF&
End If
End Function
Si quelqu'un pouvait se pencher sur mon cas;merci d'avance