Protection OK sur 2000, HS sur 2007

Le
jojo
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
jojo
Le #19179561
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" 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



Joël
Le #19181681
Merci Denis,

Bizarre !!!

La procédure fonctionne parfaitement en environnement XP /2000.

Sur Vista / 2007, le classeur n'est pas protégé.

Le plus surprenant, c'est que si je mets un "Stop" juste avant la fermeture
du classeur, je me rends compte que toutes les informations ont bien été
envoyées à excel. Si je sauvegarde directement dans excel à ce moment-là,
tout va bien.

J'ai ajouter la ligne de commande "ActiveWorkbokk.Save" à la fin du code et
un .SreanUpdating = True au cas où, mais cela a été sans conséquence !!!

Même un .Wait (Now + TimeValue("0:00:10")) pour voir, mais que dalle.

Voici ci-dessous le code retenu dans ACCESS... (j'ai laissé la première
partie au cas où, mais celle-ci devrait être sans conséquence pour ce qui
nous intéresse) En revanche, je n'ai pas mis tout le reste du traitement
dans le classeur lui-même...

'=============================== Set oExcel = New Excel.Application
With oExcel
With .ActiveWorkbook.VBProject.VBComponents("ThisWorkbook")
With .CodeModule
LineNumber = .CreateEventProc("SheetChange", "Workbook")
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Dim oCell As Range"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Dim i As Long"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Application.EnableEvents = False"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " For Each oCell In Target"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If oCell <> """" Then"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If Sh.Name = """ &
oExcel.Sheets(1).Name & """ Or Sh.Name = """ & oExcel.Sheets(2).Name & """
Or Sh.Name = """ & oExcel.Sheets(3).Name & """ Then"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If Cells(Target.Row, 1) = """" Then"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " MsgBox ""You must type a valid
date before any other data"""
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Application.Undo"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Cells(Target.Row, 1).Select"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " GoTo FinProc"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " End If"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " End If"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If oCell.Column = 1 Then"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If oCell.Row >=
Range(""Moyenne"").Row - 2 Then"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Application.ScreenUpdating =
False"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " For i = 1 To 3"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Sheets(i).Select"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Activesheet.Unprotect
""SGS2009"""
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Range(""Moyenne"").Offset(-1,
0).EntireRow.Insert"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Activesheet.Protect ""SGS2009"""
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Sh.Select"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Next"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " End If"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " End If"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " End If"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " oCell.Offset(0, 1).Select"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Next"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "FinProc:"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " Application.EnableEvents = True"


End With
End With
With .ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
With .CodeModule
LineNumber = 2
.InsertLines LineNumber, "Sub ProtectVBProject(WB as Workbook, ByVal
Password as String)"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Dim VBP as Object, oWin as Object"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Dim wbActive as Workbook"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Dim i as Integer"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Set VBP = WB.VBProject"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Set wbActive = ActiveWorkbook"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "For Each oWin in VBP.VBE.Windows"
LineNumber = LineNumber + 1
.InsertLines LineNumber, " If Instr(oWin.Caption,""("") > 0 then
oWin.Close"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Next oWin"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "WB.Activate"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "Application.onKey ""%{F11}"""
LineNumber = LineNumber + 1
.InsertLines LineNumber, "SendKeys ""+{TAB}{RIGHT}%V{+}{TAB}"" &
Password & ""{TAB}"" & Password & ""~"""
LineNumber = LineNumber + 1
.InsertLines LineNumber,
"Application.VBE.CommandBars(1).FindControl(ID:%78,
recursive:=True).Execute"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "WB.Save"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "ActiveWorkbook.Save"
LineNumber = LineNumber + 1
.InsertLines LineNumber, "End Sub"
End With
End With
Forms("frmProgressBar").Caption = "Export Template Data : Protection"

.Visible = True
.ScreenUpdating = True
.Run "'" & .ActiveWorkbook.Name & "'!ProtectVBProject", .ActiveWorkbook,
"SGS2009"
' Stop
.Wait (Now + TimeValue("0:00:10"))

.ActiveWorkbook.Save
.ActiveWorkbook.Close True
End With

'============================================


--

Bien cordialement,

Joël GARBE
+336 60 58 20 68
www.joelgarbe.fr
"MichDenis" %
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" 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" 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





Joël
Le #19188301
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"
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
'------------------------------------------


Joël
Le #19187601
Merci pour toutes ces précisions Denis.

Je vais conclure le code de mon application à partir de ces suggestions.

Pour ma part, je considère le problème évoqué initialement résolu, et je
t'en remercie.

Bon Week-End

--

Bien cordialement,

Joël GARBE
www.joelgarbe.fr
"MichDenis"
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" 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"
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
'------------------------------------------




Publicité
Poster une réponse
Anonyme