Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

compiler deux macro

13 réponses
Avatar
Cyr13
bonsoir, suite a l' aide de Daniel.C
j ai pu realiser deux action dans mon fichier
mais comment faire pour que les deux macro
n' en deviennent qu' une ??


Sub Impimer_Toute_la_Prod()
'

Application.ScreenUpdating = False

For Each c In Sheets("Menus").Range("L6:L58")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
'3 si nom d'onglet en colonne C
Attente (500)
Sheets(onglet).Unprotect Password:=""
Sheets(onglet).[A6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
Sheets(onglet).[H:BH].AutoFit
Attente (500)
Sheets(onglet).PrintOut
Attente (500)
Sheets(onglet).[A6].AutoFilter
Sheets(onglet).Protect Password:=""
End If
Next
End Sub

et

Sub Filtre_Matrice_Gastro()

ActiveSheet.Unprotect
Columns("H:BK").Select
Selection.Columns.AutoFit
Attente (500)
For Each c In Sheets("Active").Range("H48:BK48")
If c.Value = "0" Then
c.ColumnWidth = 0
End If
Next
Attente (500)
Columns("AT:AT").Select
Selection.ColumnWidth = 0.5
Columns("AC:AC").Select
Selection.ColumnWidth = 0.5
Attente (500)
Range("A6:B6").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

encore merci a Daniel.C et aux autres

10 réponses

1 2
Avatar
Fredo P.
La soluce en appelant la seconde à l'intérieure de la première... bon?
mais comment faire pour que les deux macro
n' en deviennent qu' une ??

Sub Impimer_Toute_la_Prod()
ton code


Filtre_Matrice_Gastro

End Sub



Sub Filtre_Matrice_Gastro()
ton code End Sub


Avatar
Daniel.C
Bonsoir.
Le tout est de savoir dans quel ordre doivent s'exécuter les macros.Tu peux
mettre dans une 3e macro :
Sub MacroTotale()
Impimer_Toute_la_Prod
Filtre_Matrice_Gastro
End Sub
Ou tu inverses les deux lignes, s'il y a lieu. A moins qu'il ne faille
incorporer l'une des macros dans le code de l'autre ?
Cordialement.
Daniel
"Cyr13" a écrit dans le message de news:

bonsoir, suite a l' aide de Daniel.C
j ai pu realiser deux action dans mon fichier
mais comment faire pour que les deux macro
n' en deviennent qu' une ??


Sub Impimer_Toute_la_Prod()
'

Application.ScreenUpdating = False

For Each c In Sheets("Menus").Range("L6:L58")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
'3 si nom d'onglet en colonne C
Attente (500)
Sheets(onglet).Unprotect Password:=""
Sheets(onglet).[A6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
Sheets(onglet).[H:BH].AutoFit
Attente (500)
Sheets(onglet).PrintOut
Attente (500)
Sheets(onglet).[A6].AutoFilter
Sheets(onglet).Protect Password:=""
End If
Next
End Sub

et

Sub Filtre_Matrice_Gastro()

ActiveSheet.Unprotect
Columns("H:BK").Select
Selection.Columns.AutoFit
Attente (500)
For Each c In Sheets("Active").Range("H48:BK48")
If c.Value = "0" Then
c.ColumnWidth = 0
End If
Next
Attente (500)
Columns("AT:AT").Select
Selection.ColumnWidth = 0.5
Columns("AC:AC").Select
Selection.ColumnWidth = 0.5
Attente (500)
Range("A6:B6").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

encore merci a Daniel.C et aux autres



Avatar
Cyr13
bonsoir,
en fait le but et de trouver le feuille y appliquer tout les filtre et l '
imprimer.

merci
Avatar
Daniel.C
Des filtres, il y en a dans les 2 macros. Et tu ne peux filtrer qu'une plage
à la fois.
Daniel
"Cyr13" a écrit dans le message de news:


bonsoir,
en fait le but et de trouver le feuille y appliquer tout les filtre et l '
imprimer.

merci



Avatar
Cyr13
bonsoir,
j ai fait mon petit melange de ce que j aimerais que la macro fasse

Application.ScreenUpdating = False

For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
Sheets(onglet).Unprotect Password:=""
Sheets(onglet).[H:BN].AutoFit
For Each c Range("H48:BN48")
If c.Value = "0" Then
c.ColumnWidth = 0
Columns("AT:AT").Select
Selection.ColumnWidth = 0.5
Columns("AC:AC").Select
Selection.ColumnWidth = 0.5
Sheets(onglet).[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
Sheets(onglet).PrintOut
Attente (500)
Sheets(onglet).[C6].AutoFilter
Sheets(onglet).Protect Password:=""
Avatar
Daniel.C
Essaie comme ça :

Sub test()

Dim c As Range, x As Range

Application.ScreenUpdating = False
For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
With Sheets(onglet)
.Unprotect Password:=""
.[H:BN].AutoFit
For Each x In .Range("H48:BN48")
If c.Value = "0" Then
c.ColumnWidth = 0
End If
Next x
.Columns("AT:AT").ColumnWidth = 0.5
.Columns("AC:AC").ColumnWidth = 0.5
.[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
.PrintOut
Attente (500)
.[C6].AutoFilter
.Protect
End With
End If
Next c
End Sub

Daniel
"Cyr13" a écrit dans le message de news:
u74rx%
bonsoir,
j ai fait mon petit melange de ce que j aimerais que la macro fasse

Application.ScreenUpdating = False

For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
Sheets(onglet).Unprotect Password:=""
Sheets(onglet).[H:BN].AutoFit
For Each c Range("H48:BN48")
If c.Value = "0" Then
c.ColumnWidth = 0
Columns("AT:AT").Select
Selection.ColumnWidth = 0.5
Columns("AC:AC").Select
Selection.ColumnWidth = 0.5
Sheets(onglet).[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
Sheets(onglet).PrintOut
Attente (500)
Sheets(onglet).[C6].AutoFilter
Sheets(onglet).Protect Password:=""








Avatar
Cyr13
bonjour,


Sub Impimer_Toute_la_Prod()
'
'
Dim c As Range, x As Range

Application.ScreenUpdating = False
For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
With Sheets(onglet)
.Unprotect Password:=""
.[H:BN].AutoFit "j ai un message d'
erreure 1004 "la methode autofit de la classe range a echoué"
For Each x In .Range("H48:BN48")
If x.Value = "0" Then " j'ai changer c par
x"
x.ColumnWidth = 0 " j'ai changer c par x"
End If
Next x
.Columns("AT:AT").ColumnWidth = 0.5
.Columns("AC:AC").ColumnWidth = 0.5
.[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
.PrintOut
Attente (500)
.[C6].AutoFilter
.Protect
End With
End If
Next c
End SubSub
Avatar
Daniel.C
Bonsoir.
Difficile de travailler sans avoir le contexte.
Peux-tu mettre une partie de ton classeur en effaçant les données
confidentielles sur www.cjoint.com ?
Daniel
"Cyr13" a écrit dans le message de news:

bonjour,


Sub Impimer_Toute_la_Prod()
'
'
Dim c As Range, x As Range

Application.ScreenUpdating = False
For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 14)
With Sheets(onglet)
.Unprotect Password:=""
.[H:BN].AutoFit "j ai un message d'
erreure 1004 "la methode autofit de la classe range a echoué"
For Each x In .Range("H48:BN48")
If x.Value = "0" Then " j'ai changer c par
x"
x.ColumnWidth = 0 " j'ai changer c par x"
End If
Next x
.Columns("AT:AT").ColumnWidth = 0.5
.Columns("AC:AC").ColumnWidth = 0.5
.[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
.PrintOut
Attente (500)
.[C6].AutoFilter
.Protect
End With
End If
Next c
End SubSub



Avatar
Cyr13
pas de probleme aucune données sensibles

http://cjoint.com/?dmt6f2Wvwz
Avatar
Daniel.C
Essaie comme ça :

Sub Impimer_Toute_la_Prod()
'
'
Dim c As Range, x As Range

Application.ScreenUpdating = False
For Each c In Sheets("Menus").Range("L6:L60")
If c.Value = "A Imprimer" Then
onglet = Sheets("Menus").Cells(c.Row, 13)
With Sheets(onglet)
.Unprotect Password:=""
.Range("H:BN").Columns.AutoFit
For Each x In .Range("H48:BN48")
If x.Value = "0" Then
x.ColumnWidth = 0
End If
Next x
.Columns("AT:AT").ColumnWidth = 0.5
.Columns("AC:AC").ColumnWidth = 0.5
.[C6].AutoFilter Field:=1, Criteria1:="<>"
Attente (500)
.PrintOut
Attente (500)
.[C6].AutoFilter
.Protect
End With
End If
Next c
End Sub

"Cyr13" a écrit dans le message de news:

pas de probleme aucune données sensibles

http://cjoint.com/?dmt6f2Wvwz



1 2