Transfert de macro dans un nouveau classeur

Question

Bonjours a tous , je suis actuellement sur un projet d ' "envergure" , si on peut dire et je stock sur une erreur 9 "indice n'appartient pas à la selection"

voici le morceau de code car le fichier complet est très lourd.

Public Function ExportCodeModule()

' Déclaration des variables

Dim strCode As String

Dim Compteur As Integer

Dim Indice As Long

Dim modObj As Object

Dim objMod As Object

Dim Classeur As Workbook

Dim vbCom As VBComponent

Dim Lignes As Long

'selectionne le fichier source associer au projet vba

Windows("squelette catalogue achat.xlsm").Activate

' transforme le module en variable objet de vba

Set modObj = Application.VBE.ActiveVBProject.VBComponents.item("Sauvegarde")

'transforme le code en variable texte

strCode = modObj.CodeModule.Lines(1, modObj.CodeModule.CountOfLines)

'selectionne le fichier receveur associer au projet vba

Windows("Liste des composants STD.xls").Activate

Compteur = 0

For Each Classeur In Workbooks

If (Classeur.Name = "Liste des composants STD.xls") Then

' Create a new module in workbook.

Classeur.Activate

Set objMod = Classeur.VBProject.VBComponents

objMod.Add (vbext_ct_StdModule)

With objMod("Module1").CodeModule

.DeleteLines 1, .CountOfLines

End With

' transforme le texte en code et l'intègre dzns le nouveau module

objMod.item("Module1").CodeModule.AddFromString (strCode)

objMod.item("Module1").Name = "Sauvegarde1"

Compteur = (Compteur + 1)

End If

Next Classeur

End Function

je vous explique :

je souhaite grace a cette fonction transféré une macro de sauvegarde de fichier uqe j'ai au préalable créé et nommé en l'enregistrant dans un repertoire bidon.

le code qui appel la fonction:

Sub Cmd_Export_Click()

If existephoto("P:\photoref0.gif") Then

'détruit la photo ref

Kill "P:\photoref0.gif"

End If

If existephoto("P:\photofam0.gif") Then

'détruit la photo fam

Kill "P:\photofam0.gif"

End If

With Workbooks.Add

.Activate

End With

Workbooks("squelette catalogue achat.xlsm").Sheets("Panier").Range("A2", "L20").Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1")

Dim repertoire As String

Dim nomfichier As String

Dim extension As String

repertoire = "P:\"

nomfichier = "Liste des composants STD.xls"

extension = "*.xls"

ActiveWorkbook.SaveAs repertoire & nomfichier

Call ExportCodeModule

Windows("Liste des composants STD.xls").Activate

Call Save

Windows("Liste des composants STD.xls").Close

'Kill repertoire & nomfichier

'décharge le userform

Unload Me

End Sub

je travail dans un bouton d'un userform.(obligation du cahier des charges)

j'espère que j'ai été claire, si ce n'est pas le cas je représiserais.

Amadéus · Answer

Ce serait beaucoup plus clair déjà si tu prenais la peine de: 1) Eliminer les lignes blanches inutiles qui allongent inutilement ton message 2) Utiliser les balises Code pour faire ressortir ton texte de code. 3) Ton PC n'as pas de correcteur d'orthographe? Parce que nous faisons tous des fautes (en tout cas, moi, j'ai conscience d'en faire) mais le correcteur d'orthographe en élimine déjà pas mal. Parce que, sans vouloir être donneur de leçon, soigner sa présentation n'est jamais qu'une question de correction. Cordialement...