Modifation d'une macro

[wachoo31]

Bonjour à toutes et tous

Grace à vous, j'ai pu réalisé cette macro :

Sub Sauvegarde_Appointement()
Dim Chemin As String
Dim Question As String
Dim newbook As Workbook

Chemin = ThisWorkbook.Path & "\Sauvegarde des calculs\"
If Dir(Chemin, vbDirectory) = "" Then
'XLLuc on crée d'abord le répertoire si necessaire
MsgBox "Ce dossier n'existe pas"
MkDir ThisWorkbook.Path & "\Sauvegarde des calculs\"
End If

Question = Sheets("App.").Range("c13") & " " & Range("c14") & " " & Format(Date, "dd.mm.yyyy")

Application.ScreenUpdating = False

Sheets("Print App.").Activate
Sheets("Print App.").Visible = -1
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.CutCopyMode = False
Cells.Validation.Delete

With ActiveWorkbook.VBProject.VBComponents(ActiveSheet. CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With

With ActiveWorkbook
.SaveAs Chemin & Question & ".xls"
.Close '<<< supprimer si on veut garder le classeur à l'écran
End With
Sheets("Print App.").Visible = 2
Sheets("App.").Select

End Sub

Maintenant, vec une copie semblable à cette macro comment doit-je faire pour copier à la place de la feuille "sheets("App.") plusieurs feuilles du genre sheets("Cal.App.") + sheets("rev.sal.") + sheets("program.") ?

 

[job75]

Re : Modifation d'une macro

Bonjour,
Une solution, c'est de créer une collection (c par exemple) :
- déclarer c par Dim c As New Collection
- définir c(1) = "Cal.App." , c(2) = "rev.sal.", c(3) = "program."
- remplacer "App." par c(i) et faire une boucle For i = 1 To 3...Next.
A+

 

[wachoo31]

Re : Modifation d'une macro

Bonjour, job75

J'essaye ta proposition, mais la macro bloque sur le ligne

c=(Cal.App.)
Autrement dit cela bloque sur la première définition avant la boucle

 

[job75]

Re : Modifation d'une macro

Oui, désolé, je ne fais pas des collections tous les jours...
Pour définir les éléments de la collection, écrire successivement :
c.Add "Cal.App." , c.Add "rev.sal.", c.Add "program."
A+

 

[TooFatBoy]

Re : Modifation d'une macro

Non, rien...

 

[pierrejean]

Re : Modifation d'une macro

bonjour wachoo31

Salut Job

Une autre approche

A tester

'Application.ScreenUpdating = False
[COLOR=blue]Feuilles = Array("Cal.App", "rev.sal", "programm")[/COLOR]
[COLOR=blue]For n = 0 To UBound(Feuilles)[/COLOR]
Sheets([COLOR=blue]Feuilles(n[/COLOR][COLOR=blue])[/COLOR]).Activate
Sheets([COLOR=blue]Feuilles(n[/COLOR][COLOR=blue])[/COLOR]).Visible = -1
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Validation.Delete
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
With ActiveWorkbook
.SaveAs Chemin & Question & ".xls"
.Close '<<< supprimer si on veut garder le classeur à l'écran
End With
Sheets([COLOR=blue]Feuilles(n[/COLOR][COLOR=blue])[/COLOR]).Visible = 2
Sheets("App.").Select
[COLOR=blue]Next n[/COLOR]
End Sub

nb: j'ai mis le screenupdating en commentaire pour tes essais

 

[wachoo31]

Re : Modifation d'une macro

Bonsoir, pierrejean
Re, job75

Je teste vos explications, mais cela ne marche pas, notament la solution de pierrejean il me met

Erreur de compilation :
Variable non facultatif
Voici la macro complète /

Sub Sauvegarde_Garantie()
Dim Chemin As String
Dim ici As String
Dim Question As String
Dim newbook As Workbook
Dim Feuilles As New Collection

Dim n As Integer

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Souhaitez-vous continuer?"    ' Définit le message.
Style = vbYesNo + vbQuestion + vbDefaultButton2    ' Définit les boutons.
Title = "Sauvegarde du calcul "    ' Définit le titre.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then Exit Sub   ' L'utilisateur a choisi Oui.


ici = ThisWorkbook.Path
Chemin = ThisWorkbook.Path & "\Sauvegarde des calculs\"
If Dir(Chemin, vbDirectory) = "" Then
'XLLuc on crée d'abord le répertoire si necessaire
MsgBox "Excel va créé un dossier Sauvegarde des calculs dans " & ici & "  et y copié le calcul >>"
MkDir ThisWorkbook.Path & "\Sauvegarde des calculs\"
End If

Question = Sheets("cal.app.").Range("c23") & " " & Range("c24") & " " & Format(Date, "dd.mm.yyyy")

'Application.ScreenUpdating = False
Feuilles = Array("cal.app.", "rev.sal.", "program.")
For n = 0 To UBound(Feuilles)
Sheets(Feuilles(n)).Activate
Sheets(Feuilles(n)).Visible = -1
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Validation.Delete
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
With ActiveWorkbook
.SaveAs Chemin & Question & ".xls"
.Close '<<< supprimer si on veut garder le classeur à l'écran
End With
Sheets(Feuilles(n)).Visible = 2
Sheets("App.").Select
Next n
End Sub

MErci de votre passience

 

[pierrejean]

Re : Modifation d'une macro

Re

L'erreur vient probablement de

Dim Feuilles As New Collection

A remplacer par

Dim Feuilles As Variant

 

[wachoo31]

Re : Modifation d'une macro

Bonsoir pierrejean, job75, le forum

Mille excuses pour la réponse tardive, mais la solution de pierrejean marche bien sauf que pour mon fichier, j'ai des soucis. je m'explique.
La macro en question est lancée par un bouton sur la feuille "cal.app." pendant que sont affichés uniquement les onglets "cal.app.","rev.sal","program." et "IUR".
Et cette macro doit lancer la cretion d'un nouveau classeur, copier les feuilles "Print cal.app.",Print.app." et "Print program." ensuite enregister le classeur créé avec comme nom la valeur de la cellule "C24"&"C25" de l'onglet "cal.app." puis fermer le classeur et revenir sur l'onglet "cal.app." et s'est la que la solution de pierrejean me pose soucis.
PS: Je ne sais pas mettre d'exemple de classeur car trop volumineux.

Oups