Discussion :

[illight]

EN copiant (surement) ce qu'a dit Ouskelnor ici :

http://www.developpez.net/forums/sho...73#post3040073


Je me pose une question : est-ce qu'il est possible d'importer une macro dans un nouveau classeur déja exister, quitter le classeur actuel et continuer à faire travailler une macro sur ce meme classeur existant ?

Je m'explique par un exemple :
On a par exemple un classeur nommé "Classeur1" où l'on a plusieurs modules.
On a un un autre classeur nommé "Classeur2", sans aucun module.

Est-ce qu'il est possible, en étant dans le classeur1, d'ouvrir le classeur 2, de lui importer un des modules de Classeur1, de fermer Classeur1, et de continuer à faire tourner une macro sur le classeur2.

Je demande ça, car en fait ça m'intéresse fortement, je vous explique rapidement pourquoi :
j'ai un Classeur ou je fais de la modification de données par macro, qui après importe une des feuilles de ce classeur dans Access, qui par la suite m'exportera le résultat d'une requête sous Excel, mais dans un nouveau Classeur. Or ça m'embête un peu de "piloter" ce deuxième classeur Excel à partir du premier, alors que je n'en ai normalement plus besoin. Du coup, je voudrais fermer ce premier, en important un module du 1er classeur, où j'ai une suite de modifications à faire sur le résultat de la requete, dans le 2e classeur créé par Access et continuer à travailler sur ce 2e, sans avoir le premier d'ouvert.


je sais pas si je me suis fait bien comprendre par ce que je demande, mais je pense que, dans la continuité du travail de Ouskelnor (je te lance un challenge ) dans l'importation de modules, ça pourrait être intéressant de savoir si ceci est possible, et si oui comment.

Merci d'avance pour votre lecture de ce pâté, et merci à vous de l'aide que vous m'apporterez.

[Le Pierre]

bonjour

J'ai une solution à te proposer :

J'ai dans un classeur de mise à jour un module nommé "Transfert_Code" qui contient le code ci dessous et un autre module nommé "Macros_PB" que je veux exporter dans un autre classeur.
Exécute la procédure "TransfertCode" et ton module "Macros_PB" sera transféré.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
Sub TransfertCode()
    Call RechercheFichier(Chemin, Fichier)
    Application.ScreenUpdating = False
 
    ' --- Version 1.1 ---
    Dim novPJ As Workbook
    Dim oldPJ As Workbook
 
    fich = ThisWorkbook.FullName
    Set oldPJ = ThisWorkbook
    fichN = ThisWorkbook.Name
    fich = Fichier
'----------------------------------------------------------   
'éventuellement si le classeur est protégé
    'UnprotectVBProject Workbooks(Fichier), "codeKey"
    'pour qu'Excel reconnaisse la nouvelle situation (déprotection)
    'DoEvents
'----------------------------------------------------------    
    Windows(fich).Activate
    Set novPJ = ActiveWorkbook
 
    'Effacement module
    On Error GoTo GestionErreur
    Dim VBC As Object
    With ActiveWorkbook.VBProject
        For Each VBC In .VBComponents
            If VBC.Type <> 100 Then
                'With VBC.CodeModule
                '    .DeleteLines 1, .CountOfLines
                '    .CodePane.Window.Close
                'End With
                'Else:
                .VBComponents.Remove VBC
            End If
        Next VBC
    End With
 
    'Transfert module
    fich1 = ThisWorkbook.Path & "\atata.jak"
    'toto.Type=3 pour une UserForm
    'toto.Type=1 pour un module
    'toto.Type=100 pour Thisworkbook
    For Each toto In oldPJ.VBProject.VBComponents
        a = toto.Name
        If toto.Type < 90 Then
            If a = "Macros_PB" Then
                toto.Export (fich1)
                novPJ.VBProject.VBComponents.Import (fich1)
            End If
        End If
    Next toto
    Kill fich1
    Application.ScreenUpdating = True
    Beep
    MsgBox "Macro du classeur actif transférées.", _
    vbInformation
Exit Sub
GestionErreur:
Select Case Err.Number
        Case 50289
            '---le classeur n'est pas déprotégé----
            Msg = "Le fichier ne peut pas être déprotégé !" & Chr(10) & Chr(13) & Chr(13) & _
                "Procédure interrompue."
            Style = vbOKOnly + vbExclamation
            Title = "   Mise à jour des macros"
            Response = MsgBox(Msg, Style, Title)
            Exit Sub
        Case Else
            MsgBox ("Erreur N° " & Err & Chr(10) & Chr(13) & Error(Err))
            Exit Sub
    End Select
End Sub
 
 
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
  Dim vbProj As Object
  Set vbProj = WB.VBProject
 
  'can't do it if already unlocked!
  If vbProj.Protection <> 1 Then Exit Sub
 
  Set Application.VBE.ActiveVBProject = vbProj
 
  ' now use lovely SendKeys to quote the project password
  SendKeys Password & "~~"
  Application.VBE.CommandBars(1).FindControl(Id:=2578, recursive:=True).Execute  '2578 Tag:="Protection",
End Sub
 
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
  Dim vbProj As Object
 
  Set vbProj = WB.VBProject
 
  'can't do it if already locked!
  If vbProj.Protection = 1 Then Exit Sub
 
  Set Application.VBE.ActiveVBProject = vbProj
 
  ' now use lovely SendKeys to set the project password
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & _
Password & "~"
 
  Application.VBE.CommandBars(1).FindControl(Id:=2578, recursive:=True).Execute
 
  WB.Save
End Sub
'================
 
 
Sub RechercheFichier(Chemin, Fichier)
    Application.ScreenUpdating = False
 
    Fichier_Analyse = ThisWorkbook.Name
 
    On Error GoTo ErreurNomRépertoire
    If Chemin <> "" Then
        '--- Se place dans le répertoire de l'application ---
        Path = Chemin
        Lect = Left(Path, 1)
        ChDrive Lect
        If InStr(1, Path, "\", 1) <> 0 Then
            ChDir Path
        End If
    End If
 
    fileToOpen = Application _
        .GetOpenFilename("Excel Files (*.xls), *.xls")
    If fileToOpen <> False Then
        'MsgBox "Open " & fileToOpen
        Workbooks.Open fileToOpen
    End If
 
    x = 0
    Do
        x = InStr(x + 1, fileToOpen, "\")
        If x = 0 Then Exit Do
        Memox = x
    Loop Until x = 0
    Chemin = Left(fileToOpen, Memox)
    Fichier = Right(fileToOpen, Len(fileToOpen) - Memox)
    If Chemin = "" Then Beep: End
 
    Windows(Fichier_Analyse).Activate
    '--- Se place dans le répertoire de l'application ---
    Path = Chemin
    Lect = Left(Path, 1)
    ChDrive Lect
    If InStr(1, Path, "\", 1) <> 0 Then
        ChDir Path
    End If
 
'-------------------------------------------------
'--- Gestion des erreurs ---
 
Exit Sub
ErreurNomRépertoire:
Beep
Select Case Err.Number
        Case 76
            Chemin = ""
            Resume Next
        Case Else
            MsgBox ("Erreur N° " & Err & Chr(10) & Chr(13) & Error(Err))
            Exit Sub
    End Select
End Sub