Bonjour
J'utilise une macro pour imprimer une zone de texte selon le nombre de joueurs (Merci a son auteur)
Si c'était possible jusqu'à 60 joueurs dans chaque tour pour les parties doublettes et tètes a tètes d'imprimer sur la même feuille
ou sinon une macro supplémentaire et je rajouterais un bouton
ci joint fichier en exemple
Merci de votre aide
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub SelectionZones()
Dim Sh As Worksheet
Dim rng1 As Range, rng2 As Range, cel As Range
Dim dL%, I%, j%, N%
Dim adr()
adr = Array("AP1:AV60", "AX1:BD36", "AX37:BD56", "BF1:BL36", "BF37:BL56", "BN1:BT36", "BN37:BT56")
Set Sh = Sheets("Triplettes F")
With Sh
For I = 0 To UBound(adr)
Set rng1 = .Range(adr(I))
N = rng1.Rows.Count
dL = N
For j = N To 5 Step -1
If rng1.Cells(j, 3).Value2 = 0 Then dL = dL - 1
Next j
Set rng2 = rng1.Range(Cells(1, 1), Cells(dL, 7))
Call Imples4toursTriplettesF_2(rng2)
Next I
Range("A1").Select
End With
End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Imples4toursTriplettesF_2(Rng)
Rng.Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True
Range("A1").Select
End Sub
J'utilise une macro pour imprimer une zone de texte selon le nombre de joueurs (Merci a son auteur)
Si c'était possible jusqu'à 60 joueurs dans chaque tour pour les parties doublettes et tètes a tètes d'imprimer sur la même feuille
ou sinon une macro supplémentaire et je rajouterais un bouton
ci joint fichier en exemple
Merci de votre aide
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub SelectionZones()
Dim Sh As Worksheet
Dim rng1 As Range, rng2 As Range, cel As Range
Dim dL%, I%, j%, N%
Dim adr()
adr = Array("AP1:AV60", "AX1:BD36", "AX37:BD56", "BF1:BL36", "BF37:BL56", "BN1:BT36", "BN37:BT56")
Set Sh = Sheets("Triplettes F")
With Sh
For I = 0 To UBound(adr)
Set rng1 = .Range(adr(I))
N = rng1.Rows.Count
dL = N
For j = N To 5 Step -1
If rng1.Cells(j, 3).Value2 = 0 Then dL = dL - 1
Next j
Set rng2 = rng1.Range(Cells(1, 1), Cells(dL, 7))
Call Imples4toursTriplettesF_2(rng2)
Next I
Range("A1").Select
End With
End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Imples4toursTriplettesF_2(Rng)
Rng.Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True
Range("A1").Select
End Sub