1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
|
Sub OterProtectionPRojetVBA()
On Error GoTo 1
Dim Wk As Workbook, motdepasse As String
Dim NomDuModule As String, FichierÀOuvrir As String
Dim LeCodeAInsérer As String
'Créateur MichD
'**********Variables à définir*************
'Supposons nom du module source et de
'destination est le même: MichD
'Le module "MichD" existe déjà dans le fichier de destination.
NomDuModule = "Module2" '------------------------------------------- nom module source
motdepasse = "test" '---------------------------------------- mot de passe fichiers
FichierÀOuvrir = Application.GetOpenFilename()
'*******************************************
Application.ScreenUpdating = False
'Définir la variable LeCodeAInsérer avec le contenu du
'module MichD existant dans le module "MichD" de ce fichier
With ThisWorkbook.VBProject.VBComponents("module2").CodeModule '----- module cible
If .CountOfLines > 0 Then
LeCodeAInsérer = .Lines(1, .CountOfLines)
End If
End With
'Ouvrir le classeur contenant le module à modifier
Application.EnableEvents = False
'ton code d'ouverture du fichier A
Set Wk = Workbooks.Open(FichierÀOuvrir)
'Wk.Visible = False
'Déprotéger le projetVBA du fichier qu'on vient d'ouvrir
Application.EnableEvents = True
UnprotectVBProject Wk, motdepasse
'Supprimer le code du module "MichD" qu'on vient d'ouvrir
Call Supprime__Code_Module(Wk, NomDuModule)
'Ajouter le code du module "MichD" de ce fichier au
'Module "MichD" du fichier qu'on vient d'ouvrir
Call Insérer_Nouveau_Code(Wk, NomDuModule, LeCodeAInsérer)
'Fermeture du classeur modifié
Wk.Close True
'Ouvrir le classeur - Vérifier si le job est bien fait!
ThisWorkbook.Application.Visible = True
GoTo 2
1:
msgbox "une erreur est survenue, veuillez quitter le programme et recommencer ou prendre contact avec xxxxxxx"
'Application.Quit
2:
CreateObject("Wscript.shell").Popup "La mise à jour s'est effectuée avec succès, le programme va sauvegarder les changements veuillez patienter...", 5, "Effectué", vbExclamation
ThisWorkbook.Application.Visible = False
patience1.Show
CreateObject("Wscript.shell").Popup "La sauvegarde est effectuée, vous pouvez continuer a travailler sur le programme.", 5, "Terminé", vbExclamation
'Application.Quit
End Sub
'-----------------------------------------
Sub UnprotectVBProject(WB As Workbook, ByVal motdepasse As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
'Ne peut procéder si le projet est non-protégé.
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
'Utilisation de "SendKeys" Pour envoyer le mot de passe.
msgbox motdepasse
Application.wait (Now() + TimeValue("00:00:01"))
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
Application.wait (Now() + TimeValue("00:00:01"))
SendKeys motdepasse, True
SendKeys "{ENTER}", True
msgbox "apres execute"
Application.wait (Now + TimeValue("00:00:01"))
End Sub
'-----------------------------------------
Sub Supprime__Code_Module(Wk As Workbook, NomModule As String)
With Wk.VBProject.VBComponents(NomModule).CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub
'-----------------------------------------
Sub Insérer_Nouveau_Code(Wk As Workbook, NomDuModule As String, Code As String)
With Wk.VBProject.VBComponents(NomDuModule).CodeModule
.AddFromString Code
End With
End Sub |
Partager