Mise en page extraction Listbox

Bonjour à tous,

Je dispose d'un formulaire qui me sert à croiser les informations entre SALARIES (choix par Combobox1) ACTIVITES (choix par ListBox1) et RISQUES PROFESSIONNELS (réunis en ListBox2).

Par confort, la liste des ACTIVITES pratiquées par le SALARIE sélectionné est répété en une ListBox3.

Par ce formulaire, je visé à éditer une fiche d'exposition individuelle qui reprendra:
- le NOM et Prénom du Salarié
- la liste de SES ACTIVITES
- la liste des RISQUES auxquels il est exposé

Cette fiche individuelle devant être imprimée, une mise en page doit être respectée... OR à ce stade, je ne parviens pas à obtenir que les ACTIVITES pratiquées par le SALARIE se renseigne dans un tableau de 18 cellules non contigües (3 lignes de 6 cellules)


Si j'utilise le code:

Code:

---

1 2 3

For i = 0 To ListBox3.ListCount - 1 .Cells(5, i + 1) = Me.ListBox3.List(i) Next i

---

le contenu de ma listbox s'aligne en ligne 5 indéfiniment (de 1 à 15 items).. Or ma mise en page impose un "retour à la ligne" à la 6ème colonne, sans cela les items en dehors de la zone d'impression ne seront logiquement pas imprimés!

Et si j'utilise le code:

Code:

---

1 2 3 4 5

.Cells(5, 1) = Me.ListBox3.List(0) .Cells(5, 2) = Me.ListBox3.List(1) .Cells(5, 3) = Me.ListBox3.List(2) ... .Cells(7,6) = Me.Listbox3.List(18)

---

Le transfert échoue dès lors que le nombre d'items à transférer est inférieur à 18 !

Merci de vos éclairages!

Bonjour,

Tu pourrais te baser sur ce code, je pense, en utilisant ta listbox plutôt qu'un Range

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Dim I As Long, Ligne As Long, Colonne As Long   Ligne = 5 Colonne = 2 For I = 1 To 20 Cells(Ligne, Colonne) = Range("A" & I) Colonne = Colonne + 1 If I Mod 6 = 0 Then 'si 6e item écrit Ligne = Ligne + 1 'on change de ligne et on remet la colonne à 2 Colonne = 2 End If Next

---

Piste prometteuse... mais plantage!

J'ai réussi à adpater le code proposé en remplaçant

Code:

---

Range("A" & I)

---

par

Code:

---

Me.ListBox3.List(I)

---

J'ai effectué 2 - tests fonctionnels mais depuis je retourne l'erreur 381 !

peut être la source qui n'est plus ou mal déclarée...

Il faudrait voir ton bout de code et spécifier sur quelle ligne survient l'erreur.

Dans son ensemble:

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 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92

Private Sub CExpositionAgent_Click()     With Worksheets("FICHEAGENT")     .Cells(2, 5).Value = ComboBox1.Text .Cells(2, 3).Value = TextBox20.Text .Cells(12, 1).Value = Label1.Caption .Cells(12, 2).Value = Label2.Caption .Cells(12, 3).Value = Label3.Caption .Cells(12, 4).Value = Label4.Caption .Cells(12, 5).Value = Label5.Caption .Cells(12, 6).Value = Label6.Caption .Cells(14, 1).Value = Label7.Caption .Cells(14, 2).Value = Label8.Caption .Cells(14, 3).Value = Label9.Caption .Cells(14, 4).Value = Label10.Caption .Cells(14, 5).Value = Label11.Caption .Cells(14, 6).Value = Label12.Caption .Cells(16, 1).Value = Label13.Caption .Cells(16, 2).Value = Label14.Caption .Cells(16, 3).Value = Label15.Caption .Cells(16, 4).Value = Label16.Caption .Cells(16, 5).Value = Label17.Caption .Cells(16, 6).Value = Label18.Caption .Cells(18, 1).Value = Label19.Caption .Cells(18, 2).Value = Label20.Caption .Cells(18, 3).Value = Label21.Caption .Cells(18, 4).Value = Label22.Caption .Cells(18, 5).Value = Label23.Caption .Cells(18, 6).Value = Label24.Caption .Cells(20, 1).Value = Label25.Caption .Cells(20, 2).Value = Label26.Caption .Cells(20, 3).Value = Label27.Caption .Cells(20, 4).Value = Label28.Caption .Cells(20, 5).Value = Label29.Caption .Cells(20, 6).Value = Label29.Caption   .Image1.Picture = Me.Image1.Picture .Image2.Picture = Me.Image2.Picture .Image3.Picture = Me.Image3.Picture .Image4.Picture = Me.Image4.Picture .Image5.Picture = Me.Image5.Picture .Image6.Picture = Me.Image6.Picture .Image7.Picture = Me.Image7.Picture .Image8.Picture = Me.Image8.Picture .Image9.Picture = Me.Image9.Picture .Image10.Picture = Me.Image10.Picture .Image11.Picture = Me.Image11.Picture .Image12.Picture = Me.Image12.Picture .Image13.Picture = Me.Image13.Picture .Image14.Picture = Me.Image14.Picture .Image15.Picture = Me.Image15.Picture .Image16.Picture = Me.Image16.Picture .Image17.Picture = Me.Image17.Picture .Image18.Picture = Me.Image18.Picture .Image19.Picture = Me.Image19.Picture .Image20.Picture = Me.Image20.Picture .Image21.Picture = Me.Image21.Picture .Image22.Picture = Me.Image22.Picture .Image23.Picture = Me.Image23.Picture .Image24.Picture = Me.Image24.Picture .Image25.Picture = Me.Image25.Picture .Image26.Picture = Me.Image26.Picture .Image27.Picture = Me.Image27.Picture .Image28.Picture = Me.Image28.Picture .Image29.Picture = Me.Image29.Picture   Dim I As Long, Ligne As Long, Colonne As Long   Ligne = 5 Colonne = 2 For I = 1 To 20 Cells(Ligne, Colonne) = Me.ListBox3.List(I) Colonne = Colonne + 1 If I Mod 6 = 0 Then 'si 6e item écrit Ligne = Ligne + 1 'on change de ligne et on remet la colonne à 2 Colonne = 2 End If Next   End With     Unload FIDENTIFICATION Unload FSECTORISATION Unload FMAÎTRISE Unload FFICHEAGENT Worksheets("FICHEAGENT").Select   End Sub

---

résultat "Impossible de lire la propriété List. Index de table de propriété non valide."

la ligen en cause:

Code:

---

Cells(Ligne, Colonne) = Me.ListBox3.List(I)

---

Bonjour,

mauvaise utilisation de la propriété List, quel est donc son premier indice ?

Une simple lecture de l'aide VBA interne aiderait forcément à corriger le code …

___________________________________________________________________________________________________________

Je suis Paris, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

Essaie comme ceci pour voir

Code:

---

1 2 3 4 5 6 7 8

For I = 0 To Me.ListBox3.ListCount - 1 Cells(Ligne, Colonne) = Me.ListBox3.List(I) Colonne = Colonne + 1 If I+1 Mod 6 = 0 Then 'si 6e item écrit Ligne = Ligne + 1 'on change de ligne et on remet la colonne à 2 Colonne = 2 End If Next

---

Je viens de relire ligne par ligne et ai trouvé quelque chose de fonctionnel ainsi:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

With Me.ListBox3 Ligne = 5 Colonne = 1 For I = 1 To .ListCount - 1 Cells(Ligne, Colonne) = .List(I, 0) Colonne = Colonne + 1 If I Mod 6 = 0 Then 'si 6e item écrit Ligne = Ligne + 1 'on change de ligne et on remet la colonne à 2 Colonne = 1 End If Next End With End With

---

proposition similaire à celle de parmi!

En revanche, instable lorsque je change d'onglet... (les cases modifiées viennent de faufiler dans l'onglet actif!?)

EDIT : je viens de paramétrer l'activation de l'onglet FICHEAGENT à l'ouverture de l'USF de manière à être certain de la destination de mon envoi!

Normal, respecter le modèle objet d'Excel à savoir la hiérarchie classeur puis feuille puis cellule ou plage …

Exemple ligne n°5 : Cells n'étant pas précédé d'une référence de feuille, alors c'est dans la feuille active
mais vu la présence de Me si le code est situé dans le module d'une feuille de calculs
alors c'est forcément dans la feuille de ce module même si elle n'est pas active !