Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" <jojo@discussions.microsoft.com> a écrit dans le message de groupe
de discussion : 280F8552-51F4-403D-8259-FB65E9553521@microsoft.com...
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Jojo,
La procédure suggérée fonctionne bien. Le problème provient du fait
que cette procédure est lancée dans une nouvelle instance d'excel
à partir d'une autre application. Ce faisant, la commande "SendKeys"
pose problème !
Un contournement possible, si le classeur qui est ouvert possède déjà
la macro "ProtectVBProject" dans un de ses modules standard, on
pourrait alors l'appeler de l'application Access.
La procédure ressemblerait à ceci :
Macro dans un module de l'application Access
'------------------------------------------------------
Sub test()
Dim oExcel As Object
Dim Wk As Workbook
Dim Chemin As String
Dim Fichier As String
'Chemin du fichier et nom du fichier à ouvrir
Chemin = "c:usersDMdocuments"
Fichier = "Classeur1.xls"
'Création d'une nouvelle instance d'excel
Set oExcel = CreateObject("excel.Application")
With oExcel
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
oExcel.Run "Classeur1.xls!ProtectVBProject", Wk, "denis"
'Fermeture du classeur et sauvegarde
.Close True
End With
'Fermeture de l'instance d'excel
oExcel.Quit
End Sub
'------------------------------------------------------
Macro dans un module du fichier que l'on veut ouvrir
'------------------------------------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
L'autre alternative consiste à ajouter par automation un module standard
au fichier qui vient de s'ouvrir, d'y coller la procédure
"ProtectVBProject",
lancer cette macro à partir d'access. Au besoin, il est aussi possible
de supprimer le module que l'on a ajouté dans le fichier avant de le
fermer et le sauvegarder.
C'est à peine un peu plus compliquer !!!
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour Denis,
Tout d'abord merci pour la réponse,
J'ai tenté d'adapter à mon projet, (en respectant la logique me
semble-t-il), mais la chaine de caractère avec le mot de passe ne va pas
sur
le second onglet de la boîte de dialogue.
Pour mémoire, j'effectue cette manupulation à partir d'access, ce qui
donne
le code suivant :
with oExcel
.SendKeys "+{TAB}%V{+}{TAB}" & "SGS2009" & "{TAB}" & "SGS2009" & "~"
.VBE.CommandBars(1).FindControl(ID:%78, recursive:=True).Execute
etc...
le + reste inscrit dans "Nom du Projet"
le password dans description et nom du fichier d'aide...
en remplaçant "+{TAB}%V par "^{TAB} c'est pareil...
en supprimant le pointdevant SendKeys, c'est pire etc...
Si tu peux voir d'où cela peut venir ?
Un grand merci néanmoins,
Bonne journée,
Joël
"MichDenis" a écrit :Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Jojo,
La procédure suggérée fonctionne bien. Le problème provient du fait
que cette procédure est lancée dans une nouvelle instance d'excel
à partir d'une autre application. Ce faisant, la commande "SendKeys"
pose problème !
Un contournement possible, si le classeur qui est ouvert possède déjà
la macro "ProtectVBProject" dans un de ses modules standard, on
pourrait alors l'appeler de l'application Access.
La procédure ressemblerait à ceci :
Macro dans un module de l'application Access
'------------------------------------------------------
Sub test()
Dim oExcel As Object
Dim Wk As Workbook
Dim Chemin As String
Dim Fichier As String
'Chemin du fichier et nom du fichier à ouvrir
Chemin = "c:usersDMdocuments"
Fichier = "Classeur1.xls"
'Création d'une nouvelle instance d'excel
Set oExcel = CreateObject("excel.Application")
With oExcel
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
oExcel.Run "Classeur1.xls!ProtectVBProject", Wk, "denis"
'Fermeture du classeur et sauvegarde
.Close True
End With
'Fermeture de l'instance d'excel
oExcel.Quit
End Sub
'------------------------------------------------------
Macro dans un module du fichier que l'on veut ouvrir
'------------------------------------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
L'autre alternative consiste à ajouter par automation un module standard
au fichier qui vient de s'ouvrir, d'y coller la procédure
"ProtectVBProject",
lancer cette macro à partir d'access. Au besoin, il est aussi possible
de supprimer le module que l'on a ajouté dans le fichier avant de le
fermer et le sauvegarder.
C'est à peine un peu plus compliquer !!!
"jojo" <jojo@discussions.microsoft.com> a écrit dans le message de groupe
de discussion : 5F34FF47-4FB7-4369-B276-8B721912EFB1@microsoft.com...
Bonjour Denis,
Tout d'abord merci pour la réponse,
J'ai tenté d'adapter à mon projet, (en respectant la logique me
semble-t-il), mais la chaine de caractère avec le mot de passe ne va pas
sur
le second onglet de la boîte de dialogue.
Pour mémoire, j'effectue cette manupulation à partir d'access, ce qui
donne
le code suivant :
with oExcel
.SendKeys "+{TAB}%V{+}{TAB}" & "SGS2009" & "{TAB}" & "SGS2009" & "~"
.VBE.CommandBars(1).FindControl(ID:%78, recursive:=True).Execute
etc...
le + reste inscrit dans "Nom du Projet"
le password dans description et nom du fichier d'aide...
en remplaçant "+{TAB}%V par "^{TAB} c'est pareil...
en supprimant le pointdevant SendKeys, c'est pire etc...
Si tu peux voir d'où cela peut venir ?
Un grand merci néanmoins,
Bonne journée,
Joël
"MichDenis" a écrit :
Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" <jojo@discussions.microsoft.com> a écrit dans le message de groupe
de discussion : 280F8552-51F4-403D-8259-FB65E9553521@microsoft.com...
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Jojo,
La procédure suggérée fonctionne bien. Le problème provient du fait
que cette procédure est lancée dans une nouvelle instance d'excel
à partir d'une autre application. Ce faisant, la commande "SendKeys"
pose problème !
Un contournement possible, si le classeur qui est ouvert possède déjà
la macro "ProtectVBProject" dans un de ses modules standard, on
pourrait alors l'appeler de l'application Access.
La procédure ressemblerait à ceci :
Macro dans un module de l'application Access
'------------------------------------------------------
Sub test()
Dim oExcel As Object
Dim Wk As Workbook
Dim Chemin As String
Dim Fichier As String
'Chemin du fichier et nom du fichier à ouvrir
Chemin = "c:usersDMdocuments"
Fichier = "Classeur1.xls"
'Création d'une nouvelle instance d'excel
Set oExcel = CreateObject("excel.Application")
With oExcel
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
oExcel.Run "Classeur1.xls!ProtectVBProject", Wk, "denis"
'Fermeture du classeur et sauvegarde
.Close True
End With
'Fermeture de l'instance d'excel
oExcel.Quit
End Sub
'------------------------------------------------------
Macro dans un module du fichier que l'on veut ouvrir
'------------------------------------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
L'autre alternative consiste à ajouter par automation un module standard
au fichier qui vient de s'ouvrir, d'y coller la procédure
"ProtectVBProject",
lancer cette macro à partir d'access. Au besoin, il est aussi possible
de supprimer le module que l'on a ajouté dans le fichier avant de le
fermer et le sauvegarder.
C'est à peine un peu plus compliquer !!!
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour Denis,
Tout d'abord merci pour la réponse,
J'ai tenté d'adapter à mon projet, (en respectant la logique me
semble-t-il), mais la chaine de caractère avec le mot de passe ne va pas
sur
le second onglet de la boîte de dialogue.
Pour mémoire, j'effectue cette manupulation à partir d'access, ce qui
donne
le code suivant :
with oExcel
.SendKeys "+{TAB}%V{+}{TAB}" & "SGS2009" & "{TAB}" & "SGS2009" & "~"
.VBE.CommandBars(1).FindControl(ID:%78, recursive:=True).Execute
etc...
le + reste inscrit dans "Nom du Projet"
le password dans description et nom du fichier d'aide...
en remplaçant "+{TAB}%V par "^{TAB} c'est pareil...
en supprimant le pointdevant SendKeys, c'est pire etc...
Si tu peux voir d'où cela peut venir ?
Un grand merci néanmoins,
Bonne journée,
Joël
"MichDenis" a écrit :Bonjour Jojo,
La procédure "ProtectVBProject" à 2 paramètres :
A ) le classeur : tu peux utiliser :
1 -ThisWorkbook -> référence au classeur lui-même
2- Workbooks("NomDuclasseur.xls") -> classeur ouvert
3- ou une variable pointant vers un classeur
dim Wk As Workbook
Wk = Workbooks("NomDuclasseur.xls")
B ) le paramètre 2 : C'est ton mot de passe.
La procédure "Test" doit être lancée à partir de l'interface de la
feuille de calcul. Tu places ces procédures dans un module standard.
'-----------------------------
Sub test()
ProtectVBProject ThisWorkbook, "denis"
End Sub
'-----------------------------
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
WB.Activate
Application.OnKey "%{F11}"
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password &
"~"
Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute
WB.Save
End Sub
'-----------------------------
"jojo" a écrit dans le message de groupe
de discussion :
Bonjour à toutes et à tous,
Voici un code qui fonctionne parfaitement sur XP / 2000, mais qui ne
protège
plus le classeur en question sur Vista / 2007. (ce code est exécuté à
partir
d'access)
set oExcel =New Excel.Application
With oExcel
Set ctr = .VBE.CommandBars.FindControl(ID:%78)
'Ouvre la boite de dialogue Propriété de VBAProject
ctr.Execute
.Wait (Now + TimeValue("0:00:5"))
.SendKeys "^{TAB}", True
.Wait (Now + TimeValue("0:00:3"))
.SendKeys "{+}", True
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.Wait (Now + TimeValue("0:00:1"))
.SendKeys "{TAB}", True
.SendKeys "SGS2009", True
.ScreenUpdating = True
'Stop
.Wait (Now + TimeValue("0:00:10"))
.SendKeys "{ENTER}", True
End With
Sur Vista / 2007, en retirant l'apostrophe devant la commande "Stop", le
programme s'arrête avec les bonnes entrées dans le formulaire VBEProject
Propriétés... Protection etc...
Il n'y a plus qu'à appuyer sur la touche entrée pour activer la
protection
(ce qu'est sensé faire le dernier
.SendKeys "{ENTER}", True
Si quelqu'un a une idée...
Par avance merci,
Joël
Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------
Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------
Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------
Le code a été testé à partir de 2 instances d'Excel
et non à partir d'Access. Voici quelques suggestions.
A )
Ces 2 lignes de code sont désactivées, tu peux les
effacer totalement :
Dans la procédure : "test"
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
La déclaration de la variable suivante dans le haut du
module est inutile :
Public oExcel As Object
Si tu préfères utiliser une variable "Fichier" plutôt qu'une
constante, efface ceci :
'Public Const Fichier = "Classeur1.xls"
Perso, s'il s'agit toujours du même fichier, il est plus facile
de définir une constante dans le haut du fichier que de chercher
la variable fichier dans le code !
B )
Si tu veux insérer ou supprimer une information dans la feuille de calcul
et
que cette dernière est protégée, Il est préférable d'utiliser le nom de la
propriété "Name" de l'objet "Feuille" visible dans la fenêtre de l'éditeur
de code et de s'affranchir du nom de l'onglet d'une feuille qui peut être
renommée. Perso, Il faut éviter les "ActiveSheet"
Dans la procédure : "Supprimer_Le_Module"
Pour récupérer le nom de l'onglet MAIS à partir de la propriété Name de la
feuille
'Toto représente le nom de la propriété de la feuille
Dim Feuil as String
Feuil
=wk.Worksheets(wk.VBProject.VBComponents("Toto").Properties("Index")).Name
with Xl
.EnableEvents = False
with .Worksheets(Feuil)
.Unprotect "SGS2009"
.Range("D15").ClearContents
.Protect "SGS2009"
end with
.EnableEvents = True
End With
Si après ces lignes de code tu veux fermer le classeur,
fait le dans la procédure "Test" qui lance toute la procédure
Dim Wk As Object
'Tu ajoujes ceci à ta procédure
Set Wk = Xl.Workbooks(Fichier)
Wk.Close True
Xl.Quit
Set Wk = Nothing:Set xl = Nothing
Et tu fais disparaître toutes ces lignes dans la procédure
"Supprimer_Le_Module"
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
Ce ne sont que des suggestions... en autant que tu es satisfait !
;-)
"Joël" a écrit dans le message de groupe de
discussion :
Bonjour Denis !
Extra-Ordinaire !
Certe, ton code en l'état ne fonctionnait toujours pas, mais il m'a permis
d'aller plus loins dans l'investigation (je commençais à me dire que je
passerai outre la protection du VBProject en V2007)
En fait, il semble bien que la fenêtre "VBProject Properties" ne se ferme
pas correctement à la fin de la procédure, et qu'il faille une
intervention
sur le classeur lui-même pour la libérer avant de fermer le classeur.
ci-dessous un exemple de la modification apportée, et qui corrige
complètement le Problème...
Modifications dans Sub Supprimer_Le_Module()
Un grand merci à toi ...
'============= > Option Compare Database
Option Explicit
'Public Const Chemin = "C:Backup NECMes documentsJoël GARBE
FormationExercicesShellAnalytical2009 04 10"
'Public Const Fichier = "Classeur1.xls"
Dim Chemin As String
Dim Fichier As String
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
MsgBox "Finished"
'Xl.Quit
'Set Xl = Nothing
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
Chemin = CurrentProject.Path & ""
Fichier = "Template Woodlands - Alvania EPLF 2 - 140000007046.xls"
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Une intervention sur le classeur semble nécessaire en 2007
'Pour fermer définitivement la boîte de dialogue "VBEProject Properties"
'Sinon, plantage Excel 2007 et le classeur n'est pas protégé
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
End Sub
'===================================== >
--
Bien cordialement,
Joël GARBE
www.joelgarbe.fr
"MichDenis" a écrit dans le message de news:Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------
Le code a été testé à partir de 2 instances d'Excel
et non à partir d'Access. Voici quelques suggestions.
A )
Ces 2 lignes de code sont désactivées, tu peux les
effacer totalement :
Dans la procédure : "test"
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
La déclaration de la variable suivante dans le haut du
module est inutile :
Public oExcel As Object
Si tu préfères utiliser une variable "Fichier" plutôt qu'une
constante, efface ceci :
'Public Const Fichier = "Classeur1.xls"
Perso, s'il s'agit toujours du même fichier, il est plus facile
de définir une constante dans le haut du fichier que de chercher
la variable fichier dans le code !
B )
Si tu veux insérer ou supprimer une information dans la feuille de calcul
et
que cette dernière est protégée, Il est préférable d'utiliser le nom de la
propriété "Name" de l'objet "Feuille" visible dans la fenêtre de l'éditeur
de code et de s'affranchir du nom de l'onglet d'une feuille qui peut être
renommée. Perso, Il faut éviter les "ActiveSheet"
Dans la procédure : "Supprimer_Le_Module"
Pour récupérer le nom de l'onglet MAIS à partir de la propriété Name de la
feuille
'Toto représente le nom de la propriété de la feuille
Dim Feuil as String
Feuil
=wk.Worksheets(wk.VBProject.VBComponents("Toto").Properties("Index")).Name
with Xl
.EnableEvents = False
with .Worksheets(Feuil)
.Unprotect "SGS2009"
.Range("D15").ClearContents
.Protect "SGS2009"
end with
.EnableEvents = True
End With
Si après ces lignes de code tu veux fermer le classeur,
fait le dans la procédure "Test" qui lance toute la procédure
Dim Wk As Object
'Tu ajoujes ceci à ta procédure
Set Wk = Xl.Workbooks(Fichier)
Wk.Close True
Xl.Quit
Set Wk = Nothing:Set xl = Nothing
Et tu fais disparaître toutes ces lignes dans la procédure
"Supprimer_Le_Module"
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
Ce ne sont que des suggestions... en autant que tu es satisfait !
;-)
"Joël" <joel-garbe@wanadoo.fr> a écrit dans le message de groupe de
discussion : eb96kQZxJHA.4116@TK2MSFTNGP04.phx.gbl...
Bonjour Denis !
Extra-Ordinaire !
Certe, ton code en l'état ne fonctionnait toujours pas, mais il m'a permis
d'aller plus loins dans l'investigation (je commençais à me dire que je
passerai outre la protection du VBProject en V2007)
En fait, il semble bien que la fenêtre "VBProject Properties" ne se ferme
pas correctement à la fin de la procédure, et qu'il faille une
intervention
sur le classeur lui-même pour la libérer avant de fermer le classeur.
ci-dessous un exemple de la modification apportée, et qui corrige
complètement le Problème...
Modifications dans Sub Supprimer_Le_Module()
Un grand merci à toi ...
'============= > Option Compare Database
Option Explicit
'Public Const Chemin = "C:Backup NECMes documentsJoël GARBE
FormationExercicesShellAnalytical2009 04 10"
'Public Const Fichier = "Classeur1.xls"
Dim Chemin As String
Dim Fichier As String
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
MsgBox "Finished"
'Xl.Quit
'Set Xl = Nothing
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
Chemin = CurrentProject.Path & ""
Fichier = "Template Woodlands - Alvania EPLF 2 - 140000007046.xls"
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Une intervention sur le classeur semble nécessaire en 2007
'Pour fermer définitivement la boîte de dialogue "VBEProject Properties"
'Sinon, plantage Excel 2007 et le classeur n'est pas protégé
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
End Sub
'===================================== >
--
Bien cordialement,
Joël GARBE
www.joelgarbe.fr
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
0109C7C0-B6BA-427B-8AC9-5421B34B419E@microsoft.com...
Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------
Le code a été testé à partir de 2 instances d'Excel
et non à partir d'Access. Voici quelques suggestions.
A )
Ces 2 lignes de code sont désactivées, tu peux les
effacer totalement :
Dans la procédure : "test"
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
La déclaration de la variable suivante dans le haut du
module est inutile :
Public oExcel As Object
Si tu préfères utiliser une variable "Fichier" plutôt qu'une
constante, efface ceci :
'Public Const Fichier = "Classeur1.xls"
Perso, s'il s'agit toujours du même fichier, il est plus facile
de définir une constante dans le haut du fichier que de chercher
la variable fichier dans le code !
B )
Si tu veux insérer ou supprimer une information dans la feuille de calcul
et
que cette dernière est protégée, Il est préférable d'utiliser le nom de la
propriété "Name" de l'objet "Feuille" visible dans la fenêtre de l'éditeur
de code et de s'affranchir du nom de l'onglet d'une feuille qui peut être
renommée. Perso, Il faut éviter les "ActiveSheet"
Dans la procédure : "Supprimer_Le_Module"
Pour récupérer le nom de l'onglet MAIS à partir de la propriété Name de la
feuille
'Toto représente le nom de la propriété de la feuille
Dim Feuil as String
Feuil
=wk.Worksheets(wk.VBProject.VBComponents("Toto").Properties("Index")).Name
with Xl
.EnableEvents = False
with .Worksheets(Feuil)
.Unprotect "SGS2009"
.Range("D15").ClearContents
.Protect "SGS2009"
end with
.EnableEvents = True
End With
Si après ces lignes de code tu veux fermer le classeur,
fait le dans la procédure "Test" qui lance toute la procédure
Dim Wk As Object
'Tu ajoujes ceci à ta procédure
Set Wk = Xl.Workbooks(Fichier)
Wk.Close True
Xl.Quit
Set Wk = Nothing:Set xl = Nothing
Et tu fais disparaître toutes ces lignes dans la procédure
"Supprimer_Le_Module"
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
Ce ne sont que des suggestions... en autant que tu es satisfait !
;-)
"Joël" a écrit dans le message de groupe de
discussion :
Bonjour Denis !
Extra-Ordinaire !
Certe, ton code en l'état ne fonctionnait toujours pas, mais il m'a permis
d'aller plus loins dans l'investigation (je commençais à me dire que je
passerai outre la protection du VBProject en V2007)
En fait, il semble bien que la fenêtre "VBProject Properties" ne se ferme
pas correctement à la fin de la procédure, et qu'il faille une
intervention
sur le classeur lui-même pour la libérer avant de fermer le classeur.
ci-dessous un exemple de la modification apportée, et qui corrige
complètement le Problème...
Modifications dans Sub Supprimer_Le_Module()
Un grand merci à toi ...
'============= > Option Compare Database
Option Explicit
'Public Const Chemin = "C:Backup NECMes documentsJoël GARBE
FormationExercicesShellAnalytical2009 04 10"
'Public Const Fichier = "Classeur1.xls"
Dim Chemin As String
Dim Fichier As String
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
MsgBox "Finished"
'Xl.Quit
'Set Xl = Nothing
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
Chemin = CurrentProject.Path & ""
Fichier = "Template Woodlands - Alvania EPLF 2 - 140000007046.xls"
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Une intervention sur le classeur semble nécessaire en 2007
'Pour fermer définitivement la boîte de dialogue "VBEProject Properties"
'Sinon, plantage Excel 2007 et le classeur n'est pas protégé
Wk.Activate
Xl.EnableEvents = False
Wk.ActiveSheet.Unprotect "SGS2009"
Wk.ActiveSheet.Range("D15").Value = "jojo"
Wk.ActiveSheet.Range("D15").ClearContents
Wk.ActiveSheet.Protect "SGS2009"
Wk.Close True
Xl.EnableEvents = True
'Xl.Wait (Now + TimeValue("0:00:10"))
Xl.Quit
End Sub
'===================================== >
--
Bien cordialement,
Joël GARBE
www.joelgarbe.fr
"MichDenis" a écrit dans le message de news:Bonjour Joël,
Essaie ceci :
A ) Dans le haut du module standard, déclaration des variables
'et des constantes
B ) Tu exécutes la macro "Test" à partir de l'interface de la feuille de
calcul
C ) Tu définis la Constante chemin et fichier selon ton application
D ) Tu actives les 2 dernières lignes de la macro "Supprimer_Le_Module"
si tu désires fermer le classeur que tu viens de protéger...
la protection sera en vigueur seulement à sa réouverture.
Public Const Chemin = "c:usersDMdocuments"
Public Const Fichier = "Classeur1.xls"
Public oExcel As Object
Public Module As Object
Dim Xl As Object, Wk As Object
Dim Code As String, Modul As Object
'------------------------------------------
Sub test()
Ouvrir_Fichier
Ajouter_Le_code
Execute_LaMacro
Supprimer_Le_Module
'Application.Wait (Now + TimeValue("0:00:10"))
'DoEvents
End Sub
'------------------------------------------
Sub Ouvrir_Fichier()
Dim Wk As Workbook
'Création d'une nouvelle instance d'excel
Set Xl = CreateObject("excel.Application")
With Xl
.Visible = True 'Rendre excel visible
'Ouverture du classeur à protéger
Set Wk = .Workbooks.Open(Chemin & Fichier)
End With
Set Wk = Nothing
End Sub
'------------------------------------------
Sub Ajouter_Le_code()
Dim Wk As Object, Code As String
'Le code de la macro à ajouter au module
'-------------------------------------------------
Code = "Sub ProtectVBProject(WB As Workbook," & _
"ByVal Password As String)" & vbCrLf
Code = Code & "Dim VBP As Object, oWin As Object" & vbCrLf
Code = Code & "Dim wbActive As Workbook" & vbCrLf
Code = Code & "Dim i As Integer" & vbCrLf
Code = Code & "Set VBP = WB.VBProject" & vbCrLf
Code = Code & "Set wbActive = ActiveWorkbook" & vbCrLf
Code = Code & "For Each oWin In VBP.VBE.Windows" & vbCrLf
Code = Code & "If InStr(oWin.Caption, ""("") > 0 " & _
"Then oWin.Close" & vbCrLf
Code = Code & "Next oWin" & vbCrLf
Code = Code & "WB.Activate" & vbCrLf
Code = Code & "Application.OnKey ""%{F11}""" & vbCrLf
Code = Code & "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}""" & _
" & Password & ""{TAB}"" & Password & ""~""" & vbCrLf
Code = Code & "Application.VBE.CommandBars(1).FindControl" & _
"(ID:%78, recursive:=True).Execute" & vbCrLf
Code = Code & "End Sub"
'-------------------------------------------------
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBE.MainWindow.Visible = False
'Ajout d'un module
Set Modul = Wk.VBProject.VBComponents.Add(1)
'insérer le code
With Modul.CodeModule
.AddFromString Code
End With
Wk.VBProject.VBE.MainWindow.Visible = False
Wk.Save
End Sub
'------------------------------------------
Sub Execute_LaMacro()
Dim Wk As Object, LaMacro As String
Set Wk = Xl.Workbooks(Fichier)
'Appel de la macro déjà présente dans le fichier
'que l'on vient d'ouvrir
LaMacro = "'" & Wk.Name & "'!ProtectVBProject"
Xl.Run LaMacro, Wk, "denis"
End Sub
'------------------------------------------
Sub Supprimer_Le_Module()
Dim Wk As Object
Set Wk = Xl.Workbooks(Fichier)
Wk.VBProject.VBComponents.Remove Modul
'Wk.Close True
'Xl.Quit
End Sub
'------------------------------------------