Appliquer une macro sur un répertoire à partir d'un bouton

[Hicho]

Bonsoir tout le monde!

Re, Dranreb

J'aimerai avoir de l'aide pour faire un fichier .xlsm avec un bouton qui me permet d'appliquer ma macro sur tout le répertoire et ainsi transformer tout les fichiers.
ci-joint le fichier contenant ma macro.

Cordialement,
Hicho

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Bonsoir.
Mettez mon code dans une procédure quand même !
Si c'est un bouton de commande mettez le dans le code du bouton, dans le module de la feuille, si c'est un un bouton de formulaire, dans un module ordinaire, et vous affecter la macro au bouton.
Exemple avec un bouton de commande:

Private Sub CommandButton1_Click()
Dim Dossier As String, NomFic As String
Dossier = ThisWorkbook.Path & "\Toto" ' À adapter
ChDrive Dossier: ChDir Dossier
NomFic = Dir("*.xlsm")
While NomFic <> ""
   Workbooks.Open NomFic
   WORKorderFinal2
   Workbooks(NomFic).Close True
   NomFic = Dir
   Wend
End Sub

À +

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Re, Bonjour

J'ai bien essayé mais j'ai pas pu le faire, merci de bien vouloir m'aider! je sais que c'est très simple pour vous mais pour moi c'est pas le cas. je vous remercie.

ci-joint ce que j'ai pu faire!

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Bonjour.
Bon ben c'est un bouton de formulaire, alors il faut mettre la procédure dans un module ordinaire et l'affecter au bouton. Et pas en Private surtout ! Vous pouvez mettre l'autre en Private par contre si vous mettez les deux dans le même module.
À +

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Bonsoir,
j'ai réussi à déclencher la macro à partir du bouton, mais elle s'éxecute sur le fichier ouvert dans lequel se trouve le bouton.
j'ai pas pu l'appliquer aux fichiers .xls et .xlsx qui se trouvent au répertoire contenant ce fichier bouton. un petit help serait le bienvenu et merci beaucoup.

Ci-joint ce que j'ai pu faire. je vous prie de bien vouloir m'aider

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Mettez la procédure Button2_Click devant la WORKorderFinal2 dans Module1 et affectez la à votre bouton.
Il n'y a que pour les boutons de commande de la boite à outils contrôles que les codes doivent être dans le module de la feuille, pour les boutons de l'ancien système de la vieille barre d'outils formulaire, ils doivent être dans un module ordinaire.

À +

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Re, ça s'éxecute toujours dans le fichiers où il y a le bouton

A+

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

C'est que vous avez affecté la macro WORKorderFinal2 au bouton au lieu de la macro Button2_Click

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Re,
Bonjour, j'ai créé deux module, module1 et module2, qui contiennent les codes précédent mais quand j'affecte le module1 au bouton la macro s'éxecute sur le fichier ouvert contenant le bouton.

module1:

Sub Button2_Click()
Dim Dossier As String, NomFic As String
Dossier = ThisWorkbook.Path & "\" ' À adapter
ChDrive Dossier: ChDir Dossier
NomFic = Dir("*.xls")
While NomFic <> ""
Workbooks.Open NomFic
WORKorderFinal2
Workbooks(NomFic).Close True
NomFic = Dir
Wend
End Sub

module2:

Sub WORKorderFinal2()
'
' WORKorderFinal Macro
' Work order final
'
Range("A1:O2").Select
Selection.EntireRow.Delete
Range("A12:AB31").Select
Range("AB12").Activate
Selection.EntireRow.Delete
Range("J1:AA11").Select
Selection.EntireColumn.Delete
Range("A2:J4").Select
Range("J2").Activate
Selection.EntireRow.Delete
Range("E1:I1").Select
Selection.ClearContents
Range("B1").Select
Selection.ClearContents
Range("A1").Select
Selection.Cut
Range("A16").Select
ActiveSheet.Paste
Range("I5,I7").Select
Range("I7").Activate
Selection.EntireRow.Delete
Range("H4:H6").Select
Selection.Copy
Range("F14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Columns("E:E").ColumnWidth = 8.71
Columns("E:E").ColumnWidth = 11.14
Range("I14").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "*"
Range("J14").Select
ActiveCell.FormulaR1C1 = "*"
Range("K14").Select
ActiveCell.FormulaR1C1 = "*"
Range("I14:K14").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("I4:I6").Select
Selection.Copy
Range("R14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("U14").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "*"
Range("V14").Select
ActiveCell.FormulaR1C1 = "*"
Range("W14").Select
ActiveCell.FormulaR1C1 = "*"
Range("U14:W14").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C4:C6").Select
Selection.Copy
Range("AD14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("AD14:AF14").Select
Application.CutCopyMode = False
Selection.Copy
Range("AG14").Select
ActiveSheet.Paste
Range("AD14:AI14").Select
Application.CutCopyMode = False
Selection.Copy
Range("AJ14").Select
ActiveSheet.Paste
Range("D46").Select
Application.CutCopyMode = False
Selection.Copy
Range("AP14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Selection.Copy
Range("AS14").Select
ActiveSheet.Paste
Range("AP14:AU14").Select
Application.CutCopyMode = False
Selection.Copy
Range("AV14").Select
ActiveSheet.Paste
Range("B4:B6").Select
Application.CutCopyMode = False
Selection.Copy
Range("BB14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("BE14").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "*"
Range("BF14").Select
ActiveCell.FormulaR1C1 = "*"
Range("BG14").Select
ActiveCell.FormulaR1C1 = "*"
Range("C11").Select
Selection.Copy
Range("BN14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("BN14").Select
ActiveSheet.Paste
Range("A1:K10").Select
Range("K10").Activate
Application.CutCopyMode = False
Selection.EntireRow.Delete
Range("A4").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("F4:BP4").Select
Range("BP4").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.Zoom = 100
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Calibri"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("A4").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub



Cordialement

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Bonjour.

Sub Button2_Click()
Dim NomFic As String
ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
NomFic = Dir("*.xls*")
While NomFic <> ""
   If NomFic <> ThisWorkbook.Name Then
      Workbooks.Open NomFic
      WORKorderFinal2
      Workbooks(NomFic).Close True
      End If
   NomFic = Dir
   Wend
End Sub

À +

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Bonsoir!

Après avoir testé ce code que vous m'avez proposé, j'ai rencontré un autre problème de débogage qui arrête la macro après le traitement d'un seul fichier de mon répertoire, à cause de la ligne suivante: Workbooks(NomFic).Close True

je pense que "NomFic" doit être réinitialisé n'est ce pas ?? puisqu'elle contient toujours la valeur du premier fichier

Cordialement
A+ et merci pour votre effort

 

[Dranreb]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Oui, je n'avais pas vu que vous Sauvegardiez et fermiez le classeur dans WORKorderFinal2.
À mon avis il vaudrait mieux que ce soit au même endroit que là où il est ouvert, dans la boucle de Button2_Click.
Mais on pourrait y mettre plutôt: ActiveWorkbook.Close SaveChange:=True
À +

 

[Hicho]

Re : Appliquer une macro sur un répertoire à partir d'un bouton

Merci beaucoup pour cette information ça m'a beaucoup aidé. bonne soirée à vous