[XL-2007] Mise en forme avec Macro

1 pièce(s) jointe(s)

Mise en forme avec Macro

Bonjour à Tous,

Je cherche à mettre avec une macro "Tirage au sort" en forme tous mes tableaux de groupes sur de nouvelles feuilles.
* En fonction du nb de groupes que la macro puisse générer nb de feuilles (Groupe A à ...)
* En fonction du nb d'équipes par groupe qu'elle tienne compte dans le tableau du groupe et qu'elle reporte le nom des équipes dans le tableau après le tirage au sort.

Je joins le fichier excel.

Merci d'avance pour votre aide car mes connaissances sont limitées.

Youlig

Bonjour à Tous,

Personne ne voit comment faire pour réaliser cette mise en forme ?

Merci d'avance

Youlig

Bonjour

Il y a plusieurs raisons pour lesquels tu n'as pas de réponses.

Tu mets un fichier au format 2007: hors beaucoup n'ont pas cette version.
Tu mets une pièce jointe : hors beaucoup ne peuvent ou ne veulent pas télécharger des fichiers.
Tu donnes des explications succincts.

Je te conseille de donner des explications plus clairs et des copies d'écran pour toucher un public plus large.

Philippe

2 pièce(s) jointe(s)

Merci Philippe pour ces conseils,

Je vais joindre 2 copies d'écran ( 1 du tirage et 1 du groupe).
En fait, je souhaiterais qu'à partir du tirage et après avoir déterminer le nb de groupes et le nb d'équipes par groupes, la macro puisse créer une feuille par groupe et que sur ces feuilles apparaisse directement le tableau du groupe. C'est à dire avec le bon nombre d'équipe, que les équipes tirées au sort apparaissent dans les groupes etc...

Voici le morceau de macro que je possède pour le tirage au sort :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub TiragePoules()
Dim Derlig As Integer, TabPts, NbEquipes As Integer, Col As Byte, Lig As Byte, N As Integer, i As Integer, j As Integer, k As Integer, Temp
Dim Tirage As Integer, Coll As Collection, NbGroupes, NbEquipesGroupe
 
' Désactivation de l'affichage
Application.ScreenUpdating = False
With Sheets("Tirage Groupes")
.EnableSelection = xlNoRestrictions
.Unprotect Password:="50points"
' Effacement du tirage précédent
.Range("F4:Z100").ClearContents
' Mise en tableau des équipes
Derlig = .Range("A65536").End(xlUp).Row
TabPts = .Range("A4:B" & Derlig)
NbGroupes = .Range("C2").Value
NbEquipesGroupe = .Range("D2").Value
NbEquipes = Derlig - 3
' Vérification d'un nombre d'équipes insuffisant
If NbEquipes < NbGroupes - 1 * NbEquipesGroupe Then
MsgBox "Le nombre d'équipes est insuffisant pour le nombre de groupes et d'équipes par groupe !"
' nombre d'équipes participantes supérieur au produit du nombre de groupes par celui du nombre d'équipes par groupe
ElseIf NbEquipes > NbGroupes * NbEquipesGroupe Then
MsgBox "Le nombre d'équipes est supérieur au produit du nombre de groupes par celui des équipes par groupe !"
End If
' tirage des équipes
Set Coll = New Collection
N = 0
Do
Tirage = Int((Rnd * NbEquipes) + 1)
On Error Resume Next
Coll.Add Tirage, CStr(Tirage)
On Error GoTo 0
If Coll.Count > N Then
N = Coll.Count
TabPts(N, 2) = Coll(Coll.Count)
End If
Loop Until Coll.Count = NbEquipes
' Mise en ordre croissant du tirage
ReDim Temp(1 To 1, 1 To 2)
For i = 1 To UBound(TabPts, 1)
    For j = i + 1 To UBound(TabPts, 1)
    If TabPts(j, 2) < TabPts(i, 2) Then
    Temp(1, 1) = TabPts(i, 1): Temp(1, 2) = TabPts(i, 2)
    TabPts(i, 1) = TabPts(j, 1): TabPts(i, 2) = TabPts(j, 2)
    TabPts(j, 1) = Temp(1, 1): TabPts(j, 2) = Temp(1, 2)
    End If
    Next j
Next i
' Affichage des participants dans le tableau des Poules
k = 1
For Lig = 4 To NbEquipesGroupe + 3
    For Col = 6 To NbGroupes * 2 + 5 Step 2
    On Error Resume Next
    If Err.Number = 0 Then
    .Cells(Lig, Col) = TabPts(k, 1)
    k = k + 1
    End If
    On Error GoTo 0
    Next Col
Next Lig
.EnableSelection = xlUnlockedCells
.Protect Password:="50points", Contents:=True, UserInterfaceOnly:=True, Scenarios:=True
End With
End Sub

Merci d'avance

Youlig