macro en boucle

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

Mat1987

XLDnaute Nouveau
bonjour

j'aimerais repeter cette macro sur plusieur cellule est faire aparaitre un bouton pour qui me permetterai de cliquer dessus et d'executer ma macro.

Voici ma macro

Range("B12").Select
Selection.ShowDetail = True
Range("A2").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Ordre de Fabrication du Poste"
.RightHeader = ""
.LeftFooter = "Les Abrasifs du Midi"
.CenterFooter = _
"Merci de noter les quantités réalisées par produit dans la colonne du jour"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1:N11").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$N$11"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Rows("1:30").Select
Selection.RowHeight = 56.25
ActiveWindow.SmallScroll Down:=0
Columns("A:A").Select
Columns("B:B").ColumnWidth = 11.91
Columns("C:C").ColumnWidth = 11.36
Columns("E:E").ColumnWidth = 8.55
Columns("H:H").ColumnWidth = 11.64
Columns("I:I").ColumnWidth = 11.64
ActiveWindow.SmallScroll ToRight:=5
Columns("L:L").ColumnWidth = 9.27
Columns("M:M").ColumnWidth = 12.64
Columns("N:N").ColumnWidth = 11.09
ActiveWindow.SmallScroll Down:=6
Range("A1:N30").Select
Range("N30").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("B:B").Select
Selection.EntireColumn.Hidden = True
Range("J1").Select
ActiveCell.FormulaR1C1 = "='Sélection Jour'!R3C4"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]>0,'Sélection Jour'!R3C5,"""")"
Range("J2").Select
Selection.NumberFormat = "m/d/yyyy"
Selection.AutoFill Destination:=Range("J2:J60"), Type:=xlFillDefault
Range("J2:J60").Select
Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("N1").Select
ActiveCell.FormulaR1C1 = "Visa"
Columns("B:B").Select
Selection.EntireColumn.Hidden = True
Range("N2:N111").Select
Selection.ClearContents
ActiveWindow.SmallScroll ToRight:=5
Columns("O:Y").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2").Select
ActiveSheet.Name = ActiveSheet.Range("H2")

Application.DisplayAlerts = False
ActiveSheet.Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If



End Sub

merci de m'aider je vous remercie
 
Trier par date Trier par votes
Re : macro en boucle

salut Mat1987 et le forum et BONNES FÊTES
(m'en fout que je ne devrais pas user des majuscules, na ! 😛 )

j'aimerais repeter cette macro sur plusieur cellule est faire aparaitre un bouton pour qui me permetterai de cliquer dessus et d'executer ma macro.
😕 ta macro met en page, puis efface une feuille 😕
explique clairement ce que tu veux faire, ce serait mieux, par ce que se faire ch... pour faire une présentation, pour la supprimer me semble un peu ... débile. Donc, je suppose qu'en fonction de l'emplacement du bouton, tu veux une présentation différente, une impression de la plage et une remise à zéro de ta présentation ? (quand on donne une macro, ce serait mieux si elle est complète, sans End If qui ne suit aucun If, par exemple)
Code: 
Range("B12").ShowDetail = True '*********
With ActiveSheet.PageSetup '*********
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
    .PrintArea = "$A$1:$N$11" '*********
    .LeftHeader = ""
    .CenterHeader = "Ordre de Fabrication du Poste" '*********
    .RightHeader = ""
    .LeftFooter = "Les Abrasifs du Midi" '*********
    .CenterFooter = _
    "Merci de noter les quantités réalisées par produit dans la colonne du jour" '*********
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.196850393700787)
    .RightMargin = Application.InchesToPoints(0.196850393700787)
    .TopMargin = Application.InchesToPoints(0.984251968503937)
    .BottomMargin = Application.InchesToPoints(0.984251968503937)
    .HeaderMargin = Application.InchesToPoints(0.511811023622047)
    .FooterMargin = Application.InchesToPoints(0.511811023622047)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .CenterHorizontally = True '*********
    .CenterVertically = True '*********
    .Orientation = xlLandscape '*********
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = False
    .FitToPagesWide = 1 '*********
    .FitToPagesTall = 1 '*********
    .PrintErrors = xlPrintErrorsDisplayed
End With '*********
With Range("A1:N11") '*********
    With .Borders(xlEdgeLeft) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
    With .Borders(xlEdgeTop) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
    With .Borders(xlEdgeBottom) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
    With .Borders(xlEdgeRight) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
    With .Borders(xlInsideVertical) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
    With .Borders(xlInsideHorizontal) '*********
        .LineStyle = xlContinuous
        .Weight = xlThin '*********
        .ColorIndex = xlAutomatic
    End With '*********
End With '*********
Rows("1:30").RowHeight = 56.25 '*********
Columns("B:B").ColumnWidth = 11.91 '*********
Columns("C:C").ColumnWidth = 11.36 '*********
Columns("E:E").ColumnWidth = 8.55 '*********
Columns("H:I").ColumnWidth = 11.64 '*********
Columns("L:L").ColumnWidth = 9.27 '*********
Columns("M:M").ColumnWidth = 12.64 '*********
Columns("N:N").ColumnWidth = 11.09 '*********
With Range("A1:N30") '*********
    .HorizontalAlignment = xlCenter '*********
    .VerticalAlignment = xlCenter '*********
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With '*********
Range("J1").FormulaLocal = "='Sélection Jour'!$D$3" '*********
'autre méthode de formulation ----------------------------
With Range("J2") '*********
    .FormulaR1C1 = "=IF(RC[-4]>0,'Sélection Jour'!R3C5,"""")" '*********
    .NumberFormat = "m/d/yyyy" '*********
    .AutoFill Destination:=Range("J2:J60"), Type:=xlFillDefault '*********
End With '*********
With Columns("J:J") '*********
    .Copy '*********
    .PasteSpecial Paste:=xlPasteValues '*********
End With '*********
Range("N1").FormulaLocal = "Visa" '*********
Columns("B:B").EntireColumn.Hidden = True '*********
Range("N2:N111").ClearContents
Columns("O:Y").Delete Shift:=xlToLeft
ActiveSheet.Name = ActiveSheet.Range("H2")
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
ta macro devrait faire l'objet d'une deuxième cure d'amincissement : seules les lignes avec un commentaire ********* me semblent avoir une certaines importance. Les autres pourraient être supprimées, mais sont variables en fonction du conteu ou de la forme précédents. exemple :.PrintTitleRows = "" est la valeur par défaut. pourquoi la remettre si elle est toujours ainsi ?

les 3 dernières lignes de code suppriment la feuille active, et il n'y a aucun code (que j'ai vu) qui imprime ou sauvegarde la feuille qu'on vient de mettre en page ???

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
249
MOLY_
M
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
246
fanch55
fanch55
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
C
  • Question Question
Microsoft 365 Lenteur macro mise en page
Réponses
7
Affichages
161
CortoXls
C
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
874
fanfan38
fanfan38
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
104
vazvaz
V
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
639
candido57
C
R
  • Question Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
TooFatBoy
Etoto
  • Résolu(e)
Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique
Réponses
11
Affichages
365
Etoto
Etoto
H
  • Question Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
474
vgendron
vgendron
R
  • Question Question
Microsoft 365 [RESOLU] Mail multi destinataires avec vba
Réponses
11
Affichages
2 K
romubzh35
R
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
881
Kevin38
K
R
  • Question Question
Microsoft 365 Copie ecran Userform pour envoi par mail [RESOLU]
2
Réponses
26
Affichages
2 K
MeliChat_47
M
L
  • Question Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
679
lolo_excelbeginner
L
M
  • Question Question
Microsoft 365 macro en fct de l'état d'une autre (boucle)
Réponses
3
Affichages
171
sylvanu
sylvanu
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
476
marie3107
M
B
  • Résolu(e)
XL 2016 concours / Macro imprimer le texte au maximum selon les pages
Réponses
10
Affichages
908
berru76
B
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
769
marie3107
M
Retour