Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

copier un module (protégé) dans un classeur(En VBA)

1 réponse
Avatar
dominique.leuwers
Bonjour,
Comment effectuer une copie d'un module (projet protégé par mot de passe) du
classeur actif vers un autre classeur.
J'ai utilisé ceci mais cela ne fonctionne pas quand le projet est protégé.
'exporter un module de code puis le réimporter dans un autre classeur

Sub ImportExport()
Dim tmpModule$

'fichier temporaire pour l'exportation/importation
tmpModule = "D:\mamacro.bas"

'exportation depuis le classeur qui contient ce code
ThisWorkbook.VBProject. _
VBComponents("moduleMacro1").Export tmpModule

'importation dans le Perso.xls
Workbooks("Perso.xls").VBProject. _
VBComponents.Import(tmpModule).Name = "moduleMacro1"

'destruction du fichier temporaire
Kill tmpModule
End Sub

Pouvez vous m'aider
Merci d'avance
Configuration: Windows XP
Firefox 2.0.0.14
Excell 2003

1 réponse

Avatar
MichDenis
En v'là une petite partie du code :

Le mot de passe est "denis", tu devras adapter...!

La procédure suivante déprotège le classeur, cette macro
doit être appelé par l'interface de la feuille de calcul et non
à partir de la fenètre VBA.

Lorsque le classeur est déprotégée, tu lances ta macro pour copier
ton code. Cependant, tu dois fermer le classeur et le réouvrir pour
qu'il soit à nouveau protéger.

'Tu insères un module standard et tu y copies le code suivant:
'---------------------------------------------------
Sub OterProtectionPRojetVBA()
UnprotectVBProject Workbooks(ThisWorkbook.Name), "denis"
End Sub
'---------------------------------------------------

Sub UnprotectVBProject(WB As Workbook, ByVal Password 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.

SendKeys Password & "~~"
'MsgBox "Après Mot de passe"
Application.VBE.CommandBars(1).FindControl(ID:%78, recursive:=True).Execute
Application.Wait (Now + TimeValue("0:00:1"))
SupprimeToutCodeEtFormulaire
End Sub
'---------------------------------------------------