Bonjour
Un petit exemple à tester en Basic
Code : Tout sélectionner
Sub Aleatoire
Dim oDoc as Object, maFeuille as Object, alea as Object, Donnees as Object
Dim oDonnees as Variant, oCol as Variant, x as Integer, Element as String
oDoc = thisComponent
oDonnees = Array("Legumes","Viandes","Feculents","Speciaux")
maFeuille = oDoc.CurrentController.ActiveSheet
If maFeuille.Name = "Donnees" Then
MsgBox("La procédure doit être déclenchée dans une feuille correspondant à un mois",0,"Régime")
Exit Sub
End If
oCol = Array("B","C","D","E","F","G","H")
x = 1
For Each Element in oDonnees
Select Case Element
Case "Legumes"
Donnees = oDoc.NamedRanges.getByName(Element).ReferredCells.DataArray
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
For n = 2 To 26 Step 6
For i = 0 To UBound(oCol)
If x > UBound(Alea()) Then
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
x = 1 : i = i - 1
Else
maFeuille.getCellRangeByName(oCol(i) & n).String = Donnees(alea(x)-1)(0)
x = x + 1
End If
Next i
Next n
x = 1
Case "Viandes"
Donnees = oDoc.NamedRanges.getByName(Element).ReferredCells.DataArray
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
For n = 3 To 27 Step 6
For i = 0 To UBound(oCol)
If x > UBound(Alea()) Then
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
x = 1 : i = i - 1
Else
maFeuille.getCellRangeByName(oCol(i) & n).String = Donnees(alea(x)-1)(0)
x = x + 1
End If
Next i
Next n
X = 1
Case "Feculents"
Donnees = oDoc.NamedRanges.getByName(Element).ReferredCells.DataArray
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
For n = 4 To 28 Step 6
For i = 0 To UBound(oCol)
If x > UBound(Alea()) Then
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
x = 1 : i = i - 1
Else
maFeuille.getCellRangeByName(oCol(i) & n).String = Donnees(alea(x)-1)(0)
x = x + 1
End If
Next i
Next n
x = 1
Case "Speciaux"
Donnees = oDoc.NamedRanges.getByName(Element).ReferredCells.DataArray
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
For n = 5 To 29 Step 6
For i = 0 To UBound(oCol)
If x > UBound(Alea()) Then
Alea = Combinaison(UBound(Donnees) + 1,UBound(Donnees) + 1)
x = 1 : i = i - 1
Else
maFeuille.getCellRangeByName(oCol(i) & n).String = Donnees(alea(x)-1)(0)
x = x + 1
End If
Next i
Next n
x = 1
End Select
Next
For i = 0 To 7
maFeuille.Columns.getByIndex(i).OptimalWidth = True
Next i
End Sub
La fonction Combinaison est issue du suprême d'
alhazred [Basic] Tirage au hasard sans répétition (combinaison). Pour tester, appuyer sur le bouton Générer Feuilles. Aller dans la feuille Janvier et cliquer sur Aléatoire dans la barre d'outils.
Le code est certainement optimisable.
Ajout : Suite à quelques tests, les références à la validité des listes déroulantes semblent perdues (sous AOO) lors de l'actualisation des zones nommées.
Ci-joint un nouveau fichier (toujours à tester  ), qui prend en compte le problème. |
A+
Vous ne pouvez pas consulter les pièces jointes insérées à ce message.
