Exportation et adaptation de macros

[macmag]

Bonjour,

J'ai 2 fichiers excel dont l'un comporte des macros. J'ai pour habitude d'ouvrir les 2 en simultanée, de façon à pouvoir exécuter les macros sur l'un comme sur l'autre. Mais la macro suivante ne s'exécute pas sur le 2ème fichier :

Sub CreationFichier()
Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier existe déjà
n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
Application.SheetsInNewWorkbook = 1
chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
For Each w In Worksheets
t = Mid(w.[C3].Formula, 2)
On Error Resume Next
t = Range(t).Address
If Err = 0 Then
Set Wb = Workbooks.Add 'nouveau document
w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
Wb.Close
End If
Next

je joins le fichier.

Ma 2ème requête : je voudrais que les macros apparaissent sur le 2ème fichier sans que j'ai besoin d'ouvrir le 1er

Merci d'avance pour votre aide

 

[job75]

Re : Exportation et adaptation de macros

Bonsoir macmag,

Je vous avais donné ce code le 31/07/2011 mais vous ne l'avez pas copié intégralement :

Sub CreationFichier()
 Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False 'si un fichier existe déjà
 n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
 Application.SheetsInNewWorkbook = 1
 chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
 For Each w In Worksheets
   t = Mid(w.[C3].Formula, 2)
   On Error Resume Next
   t = Range(t).Address
   If Err = 0 Then
     Set Wb = Workbooks.Add 'nouveau document
     w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
     Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
     Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
     Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
     Wb.Close
   End If
 Next
 Application.SheetsInNewWorkbook = n
 End Sub
 
Function Epure$(t$)
 Dim interdit$, i As Byte
 interdit = ":""/\<>?*[]|" 'caractères interdits dans les noms des feuilles OU des classeurs
 For i = 1 To 11
   t = Replace(t, Mid(interdit, i, 1), "#")
 Next
 Epure = t
 End Function

Pas le temps d'étudier votre problème ce soir.

Bonne nuit à tous.

 

[job75]

Re : Exportation et adaptation de macros

Bonjour macmag, le forum,

S'il y a plusieurs classeurs ouverts il faut préciser le classeur qui est traité.

Avec ceci ce sera toujours le classeur actif :

For Each w In ActiveWorkbook.Worksheets

Pour la 2ème question vous pouvez mettre cette macro dans un fichier .xla (macro complémentaire).

C'est un fichier masqué que vous pouvez faire ouvrir au démarrage d'Excel, cherchez sur le web ou le forum l'endroit où il faut le placer.

Ainsi la macro sera toujours diponible.

A+

 

[job75]

Re : Exportation et adaptation de macros

Re,

Ah j'oubliais, sur Excel 2007/2010 il faut préciser le format du fichier créé.

Donc remplacer :

Wb.SaveAs chemin & Epure(w.Name)

par :

Wb.SaveAs chemin & Epure(w.Name), IIf(w.Rows.Count > 65536, 51, 1)

A+

 

[job75]

Re : Exportation et adaptation de macros

Re,

Encore un point.

La macro ne crée un fichier que si en cellule C3 d'une feuille il y a une formule de liaison.

Ce n'est pas le cas sur votre fichier joint...

A+