Bon, je sais qu'il ne faut pas poster à la suite d'un de ses propres messages mais là, y a beaucoup de changement.
J'ai exploré ce projet car le problème n'est pas juste un soucis avec une macro.
J'en ai profité pour explorer les UDT, les énumérations, que j'aurai bien aimé trier autrement qu'avec l'ordre alphabétique sur la clé mais bon j'ai fait avec (à ce propos si quelqu'un a une solution elle m'intéresse) et le tri (merci Hubert Lambert)
Voilà le code du projet "Un concours de pêche" :
Code : Tout sélectionner
REM ***** BASIC *****
type binome
equipe$ 'nom de l'équipe
nom$ ' nom du binome
secteur% ' secteur affecté
poste% 'poste affecté
points# 'nb de points obtenus
poids# 'poids atteint
end type
type equipe
nom$ 'nom de l'équipe
binomes as variant 'tableau des binômes (pour le moment il n'y en a que deux mais qui sait si un jour...)
points% 'points totaux de l'équipe
poids% 'poids total de l'équipe
end type
function creerBinome(team$,nam$)
dim b as binome
with b
.equipe = team
.nom = nam
end with
creerBinome = b
end Function
Function creerEquipe(nam$)
dim eq as equipe
eq.nom = nam
creerEquipe=eq
end Function
Function ajouteBinome(Eq as equipe,Bi as binome)
'Ajout un binôme à une équipe
dim tabBinomes
tabBinomes = Eq.binomes
if Not(isArray(tabBinomes)) then 'tableau vide
tabBinomes = array(bi)
else
redim Preserve tabBinomes(UBound(tabBinomes)+1)
tabBinomes(UBound(tabBinomes))=bi
end if
Eq.binomes= tabBinomes
ajoutBinome=Eq
end Function
Function getBinomes()
'Récupère tous les binômes inscrits
dim oDoc as object
dim fInscription as object
dim binomes as object, bino as object
dim i%
oDoc = ThisComponent
fInscription = oDoc.Sheets.GetByName("liste des équipes")
binomes = com.sun.star.container.EnumerableMap.create("string", "any")
i=0
Do While fInscription.getCellByPosition(2,5+i).string<>""
' creerBinome(nomEquipe,nomBinome)
bino=creerBinome(fInscription.getCellByPosition(1,5+i).string, fInscription.getCellByPosition(2,5+i).string)
binomes.put(bino.nom,bino)
i=i+1
loop
getBinomes = binomes
end Function
Function getEquipes()
'Récupère toutes les équipes inscrites
dim oDoc as object
dim fInscription as object
dim equipes as object, eq as object
dim binomes as object, bi as object, enu as object
dim i%
oDoc = ThisComponent
fInscription = oDoc.Sheets.GetByName("liste des équipes")
equipes = com.sun.star.container.EnumerableMap.create("string", "any")
i=0
Do While fInscription.getCellByPosition(1,5+i).string<>""
eq=creerEquipe(fInscription.getCellByPosition(1,5+i).string)
equipes.put(eq.nom,eq)
i=i+1
loop
'maintenant au tour des binomes
binomes = getResultats()
'Ajoutons les aux équipes
enu = binomes.createValueEnumeration(False)
Do While enu.hasMoreElements
' Binôme suivant
bi = enu.nextElement
eq = equipes.get(bi.equipe)
ajouteBinome(eq,bi)
'là on peut mettre à jour les totaux par équipe
eq.points = eq.points + bi.points
eq.poids = eq.poids + bi.poids
loop
getEquipes = equipes
end Function
Function getSecteurs()
'Récupère les secteurs et les postes de tous les binômes
dim oDoc as object
dim fTirage as object
dim championnat as object,bino as object
dim i%
oDoc = ThisComponent
fTirage = oDoc.Sheets.GetByName("tirage au sort")
'Initialisation de la variable championnat
' et affectation des valeurs
championnat = getBinomes()
i=9
Do While fTirage.getCellByPosition(2,i).string<>""
bino = championnat.get(fTirage.getCellByPosition(2,i).string)
bino.secteur = fTirage.getCellByPosition(4,i).string
bino.poste = fTirage.getCellByPosition(5,i).string
i=i+1
loop
getSecteurs = championnat
end Function
Sub setSecteur
'Pourrait être un tirage aléatoire des secteurs et des postes
'si un jour l'envie de changer arrive, ah! tradition quand tu nous tiens
end Sub
Sub setFeuilleTirage
'Pour écrire les binômes inscrits sur la feuille tirage au sort
dim oDoc as object
dim fTirage as object
dim championnat as object, enu as object, elem as object
dim i%
oDoc = ThisComponent
fTirage = oDoc.Sheets.GetByName("tirage au sort")
' On récupère tous les binômes inscrit sur la feuille liste des équipes
championnat= getBinomes()
' Bouclons tous les binômes du championnat
' en créant une énumération cf : suprème de code open office forum
enu = championnat.createValueEnumeration(False)
i = 9
Do While enu.hasMoreElements
' Binôme suivant
elem = enu.nextElement
' On l'écrit sur la feuille tirage au sort
fTirage.getCellByPosition(1,i).string=elem.equipe
fTirage.getCellByPosition(2,i).string=elem.nom
i=i+1
loop
end Sub
Sub setFeuilleInscription
'Pour écrire les binômes inscrits sur la feuille liste des équipes
end Sub
Function getInscription(cheminDuFichierInscription)
'Pour récupérer les équipes et binômes inscrits
'cette macro à la place d'une fonction sur la feuille
'genre c=input(nomDuFichier)
'en enregistrant le fichier des inscriptions dans le même répertoire que le fichier du concours
end Function
Sub affecteBinomeSecteur
dim oDoc as object
dim fSecteur as object
dim secteurs as object, enu as object, elem as object
oDoc = ThisComponent
'Initialisation de la variable championnat
' et affectation des valeurs
secteurs = getSecteurs()
' Bouclons tous les binômes du championnat
' en créant une énumération cf : suprème de code open office forum
enu = secteurs.createValueEnumeration(False)
Do While enu.hasMoreElements
elem = enu.nextElement
fSecteur = oDoc.Sheets.getByName("secteur " & elem.secteur)
fSecteur.getCellByPosition(4,elem.poste+9).string = elem.nom
Loop
End Sub
sub setResultats
dim oDoc as object
dim enu as object, elem as object, b
dim resultats as object, equipes as object
dim fResultIndiv as object, fResultEquipe as object, zone as object
dim trieur
dim resBinomes$, place%, ligneDeb%, nbBinomes%, nbEquipes%
oDoc = ThisComponent
fResultIndiv = oDoc.Sheets.getByName("classement individuel")
fResultEquipe = oDoc.Sheets.getByName("classement général")
' résultats des binômes
resultats = getResultats()
'Maintenant même chose pour les équipes
equipes = getEquipes()
'Reste à écrire tout ça sur les feuilles
' Classement individuel
enu = resultats.createValueEnumeration(False)
place = 1
ligneDeb = 9
Do While enu.hasMoreElements
elem = enu.nextElement
fResultIndiv.getCellByPosition(0,place+ligneDeb).value=place
fResultIndiv.getCellByPosition(1,place+ligneDeb).string=elem.equipe
fResultIndiv.getCellByPosition(2,place+ligneDeb).string=elem.nom
fResultIndiv.getCellByPosition(3,place+ligneDeb).value=elem.points
fResultIndiv.getCellByPosition(4,place+ligneDeb).value=elem.poids
place = place+1
loop
nbBinomes = place-1
'Et trier
'Créer un descripteur pour le tri merci à Hubert Lambert
trieur = fResultIndiv.createSortDescriptor()
for each prop in trieur
if prop.Name = "ContainsHeader" then
prop.Value = True
elseif prop.Name = "SortFields" then
dim sortfield(1) as new com.sun.star.util.SortField
sortfield(0).Field = 2 ' la colonne points
sortfield(0).SortAscending = True
sortfield(1).Field = 3 ' la colonne poids
sortfield(1).SortAscending = False
prop.Value = sortfield()
end if
next prop
'La zone à trier
zone = fResultIndiv.getCellRangeByPosition(1, ligneDeb, 4, nbBinomes + ligneDeb)
zone.sort(trieur)
'Classement par équipe
enu = equipes.createValueEnumeration(False)
place = 1
ligneDeb = 9
Do While enu.hasMoreElements
elem = enu.nextElement
fResultEquipe.getCellByPosition(0,place+ligneDeb).value=place
fResultEquipe.getCellByPosition(1,place+ligneDeb).string=elem.nom
resBinomes=""
for each b in elem.binomes
resBinomes = resBinomes & b.nom & " : " & b.points & " points " & b.poids & " kg" & chr(10)
next b
fResultEquipe.getCellByPosition(2,place+ligneDeb).string=resBinomes
fResultEquipe.getCellByPosition(3,place+ligneDeb).value=elem.points
fResultEquipe.getCellByPosition(4,place+ligneDeb).value=elem.poids
place = place+1
loop
nbEquipes= place-1
'Et trier
'Créer un descripteur pour le tri merci à Hubert Lambert
trieur = fResultEquipe.createSortDescriptor()
for each prop in trieur
if prop.Name = "ContainsHeader" then
prop.Value = True
elseif prop.Name = "SortFields" then
dim sortchamp(1) as new com.sun.star.util.SortField
sortchamp(0).Field = 2 ' la colonne points
sortchamp(0).SortAscending = True
sortchamp(1).Field = 3 ' la colonne poids
sortchamp(1).SortAscending = False
prop.Value = sortchamp()
end if
next prop
'La zone à trier
zone = fResultEquipe.getCellRangeByPosition(1, ligneDeb, 4, nbEquipes + ligneDeb)
zone.sort(trieur)
zone.Rows.OptimalHeight=true
end sub
Function getResultats()
dim oDoc as object
dim feuille as object
dim championnat as object,bino as object
dim i%
oDoc = ThisComponent
championnat = getBinomes()
'Bouclons toutes les feuilles
for each feuille in oDoc.Sheets
' Si c'est une feuille de secteur
if left(feuille.name,7)="secteur" then
' On récupère les résultats
i=10
do while feuille.getCellByPosition(5,i).value>0 ' Boucle sur les postes
if feuille.getCellByPosition(4,i).string<>"" then ' Le poste est affecté à un binôme
bino = championnat.get(feuille.getCellByPosition(4,i).string)
bino.points = feuille.getCellByPosition(3,i).value
bino.poids = feuille.getCellByPosition(7,i).value
end if
i=i+1
loop
end if
next feuille
getResultats = championnat
End function
Et le fichier qui va avec
classement JRC 2017_V2.2.ods
Il y a encore pas mal de points améliorables
- Récupérer par Macro les données du fichier d'inscription
- Pouvoir ajouter un secteur à partir d'une matrice
- La mise en forme
- ...
- Et le codage bien sûr
Mais ça fait ce qui était attendu
Christophe
Vous ne pouvez pas consulter les pièces jointes insérées à ce message.
) mas je voudais assigner une macro a cette meme image.
