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("D4
6").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("C1
1").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