Remplir un formulaire avec sélection aléatoire

Question

J'espère que tous le monde va bien sur le forum, donc je reviens car une nouvelle galère ce met au travers de ma route. Donc je vous explique ce qui se passe. J'ai décidé de mettre un place un audit dans mon entreprise et j'aimerais remplir le document de manière automatique. En faite je souhaiterais pouvoir mettre dans une listbox via un bouton 20 références avec les information qui leurs sont associés de manière aléatoire. La principal difficulté est que j'ai plusieurs pages et j'aimerais que sa choisisse des pièces dans n'importe quel page. Ensuite, j'ai un second bouton qui récupère ces informations et vient les coller dans mon document et ensuite mon dernier bouton permet d'imprimer. J'ai déjà trouver mon soucis d'impression mais comme je n'ai pas le reste cela ne me sert pas à grand chose. Dans la version original j'ai plus de feuilles que dans l'exemple que je vous joint et en plus de sa il y'a des feuilles qui ne possèdent pas référence pièce (exemple la feuille ou stocké le document d'audit) il y'en a également d'autre dans mon classeur. Voilà je sais que ce que je demande ne pas doit pas être simple mais j'espère tout de même avoir des réponses positives. Je vous remercie d'avance pour votre implication et pour votre temps...

MFerrand · Answer

Un essai à tester : tirage aléatoire de 20 références parmi toutes les références du classeur. Sub TirageRéf() Dim fr(), rs(), i%, j%, n&amp;, ttr$ n = Worksheets.Count ReDim fr(1, n) For i = 1 To n If Worksheets(i).Cells(1, 2).Value Like "R*" Then fr(0, 0) = fr(0, 0) + 1 fr(0, fr(0, 0)) = i fr(1, fr(0, 0)) = Application.CountA(Worksheets(i).Columns(2)) - 1 fr(0, 1) = fr(0, 1) + fr(1, fr(0, 0)) End If Next i For n = 1 To fr(0, 1) ttr = ttr &amp; ChrW(n + 32) Next n ReDim rs(19, 4) Randomize For i = 0 To 19 n = Int(Rnd * (fr(0, 1) - i) + 1) rs(i, 4) = AscW(Mid(ttr, n, 1)) - 32 For j = 1 To fr(0, 0) If rs(i, 4) &lt;= fr(1, j) Then rs(i, 4) = rs(i, 4) + 100000 * j Exit For Else rs(i, 4) = rs(i, 4) - fr(1, j) End If Next j ttr = Replace(ttr, Mid(ttr, n, 1), "") Next i For i = 0 To 19 j = rs(i, 4) \ 100000 n = rs(i, 4) Mod 100000 With Worksheets(j) rs(i, 0) = .Cells(n + 1, 2).Value rs(i, 1) = .Cells(n + 1, 7).Value rs(i, 2) = .Cells(n + 1, 9).Value rs(i, 3) = .Cells(n + 1, 5).Value End With Next i ReDim Preserve rs(19, 3) Worksheets("Audit").Range("B8:E27").Value = rs End Sub Particularités : J'identifie les feuilles contenant des références par l'intitulé "Références" en B1. La formulation : Like "R*" pallie au fait que cet intitulé n'est pas réalisé identiquement sur toutes les feuilles et comme en pareil cas les accents risqueraient d'être également volatiles, seul le R semble stable. N'ayant pas de critères particulier pour identifier la feuille de réception, je l'ai nommée "Audit" &#91;bien qu'il ne s'agisse pas à proprement parler d'un audit mais d'une simple opération de contrôle&#93;. J'essaie dans toute la mesure du possible de ne pas affecter ce qui préexiste mais en l'occurrence les fusions de colonnes dans cette dernière feuille, sans justification, même esthétique, représentait une complication bien inutile. J'ai donc défusionné. A chaque lancement, la macro fait un nouveau tirage. Si le système te convient, tu la raccorderas à un bouton. Cordialement Ferrand...

MFerrand · Answer

Je crois savoir. Auquel cas une erreur de prise d'index de feuille. Comme sur le modèle les 3 feuilles se suivent à partir de la une cette erreur n'apparaît pas...

Je vérifie et je reviens dans un moment.

Ferrand

MFerrand · Answer

Non, Array est une fonction qui présuppose que tu connais les éléments du tableau puisque tu les lui liste dans la commande.

Là je déclare un tableau dynamique que je dimensionne en fonction du nombre de feuilles. Mais je n'y rentre que les index des feuilles concernées (On traîne quelques éléments vides, mais trop peu important pour prendre la peine de les éliminer, je ne boucle ensuite que sur les éléments remplis).

Les index ou les noms de feuilles sont équivalents (sauf si noms à rallonge quand on doit les écrire !) mais au cas particulier les index étant numériques ils permettent de coder le positionnement des références tirées. Ex: 100074 = 74e réf. (donc ligne 75) de la feuille 1.

Il y avait bien le petit problème dont j'ai parlé, qui de fait masquait une erreur qui a réapparu en le rectifiant. Une inversion de lignes et colonnes du tableau dans une partie du code. Je te le remets corrigé car les inversions de (0 ,1) à la place de (1,0) ou le contraire est le genre de correction facile à louper.

Sub TirageRéf()
    Dim fr(), rs(), i%, j%, n&, ttr$
    n = Worksheets.Count
    ReDim fr(1, n)
    For i = 1 To n
        If Worksheets(i).Cells(1, 2).Value Like "R*" Then
            fr(0, 0) = fr(0, 0) + 1
            fr(0, fr(0, 0)) = i
            fr(1, fr(0, 0)) = Application.CountA(Worksheets(i).Columns(2)) - 1
            fr(1, 0) = fr(1, 0) + fr(1, fr(0, 0))
        End If
    Next i
    For n = 1 To fr(1, 0)
        ttr = ttr & ChrW(n + 32)
    Next n
    ReDim rs(19, 4)
    Randomize
    For i = 0 To 19
        n = Int(Rnd * (fr(1, 0) - i) + 1)
        rs(i, 4) = AscW(Mid(ttr, n, 1)) - 32
        For j = 1 To fr(0, 0)
            If rs(i, 4) <= fr(1, j) Then
                rs(i, 4) = rs(i, 4) + 100000 * fr(0, j)
                Exit For
            Else
                rs(i, 4) = rs(i, 4) - fr(1, j)
            End If
        Next j
        ttr = Replace(ttr, Mid(ttr, n, 1), "")
    Next i
    For i = 0 To 19
        j = rs(i, 4) \ 100000
        n = rs(i, 4) Mod 100000
        With Worksheets(j)
            rs(i, 0) = .Cells(n + 1, 2).Value
            rs(i, 1) = .Cells(n + 1, 7).Value
            rs(i, 2) = .Cells(n + 1, 9).Value
            rs(i, 3) = .Cells(n + 1, 5).Value
        End With
    Next i
    ReDim Preserve rs(19, 3)
    Worksheets("Audit").Range("B8:E27").Value = rs
End Sub

Désolé pour ce contretemps.

Ferrand

MFerrand · Answer

Les feuilles qui n'ont pas la référence en B1 (avec un intitulé commençant par R) ne seront pas reconnues, mais les autres normalement oui, et il faut que la feuille de réception soit nommée Audit (ou alors tu changes son nom dans la macro) mais tu aurais eu une erreur. A tout hasard, après une erreur il faut réinitialiser le débogueur pour relancer.

Une autre limite pourrait être le nombre de référence : la table Unicode utilisée pour le tirage va jusqu'à 65535 (il est vrai que n'ai jamais utilisé avec des grands nombres). Mais pareil si ça avait coincé là-dessus, il y aurait eu une erreur.

Tiens-moi au courant. Dans les conditions que tu indiques, je ne vois pas de raison. Et les probabilités penchent vers le fait que la macro ne se lance pas. Si tu as une autre macro, essaie de l'exécuter...

Ferrand

MFerrand · Answer

Tout est possible, en augmentant le volume de code et éventuellement le temps d'exécution...

En gros il faut passer par un maillon supplémentaires : repérer sur chaque feuille les 4 colonnes qui nous intéressent, les stocker dans un tableau pour s'y référer ensuite...

Pour cadrer tout de même l'opération : peut-on se fier à la stabilité des libellés de champs. J'ai déjà fait la remarque pour références, écrit Références ou Référence, ce qui m'a amené à détecter sur le "R" car je me méfie des omissions d'accents. Qu'en est-il pour les autres libellés ?

Et sont-ils systématiquement sur la ligne 1 ?

Parce que selon les variabilités qu'il faut prendre en compte, on risque de finir par avoir un programme de recherche plus important que le tirage lui-même.

Bonne journée

Ferrand