XL 2016 Injecter les items d'une listbox dans une meme ligne mais une colonne sur 3 à partir d'une colonne précise

[Sparfell29]

Bonjour à tous,
pour ceux qui étaient intervenus sur mon problème précédent https://www.developpez.net/forums/d...ple-d-listbox-seule-cellule-separant-virgule/ ma direction a changé d'avis sur la façon de présenter mes données. Je dois maintenant avoir une colonne "Service concerné" par service coché dans ma listbox et les colonnes "Accord" et "Visa" allant avec. La colonne "Accord" contiendra la date d'accord du service concerné si accord il y a et simplement NON le cas contraire. La colonne "Visa" contiendra le nom de la personne responsable dudit service en guise de signature électronique.
Ma responsable veut quelque chose comme ceci :

N° Arrêt Commercialisation​

Code Produit​

Dénomination Produit​

Date Création Fiche d'Arrêt​

Date Validation​

Commentaires​

Nouveau code produit (si changement)​

Services concernés​

Accord​

VISA​

Services concernés 2​

Accord 2​

VISA 2 ​

Actions à prévoir​

​

​

​

​

​

​

​

MKT​

OK​

Cécilia​

Qualité​

OK​

Charlotte​

​

Il faut donc que je dise que je veux récupérer les éléments sélectionnés de ma listbox pour les mettre dans mon tableau toutes les trois colonnes à partir de la colonne 8. Il faut aussi que j'obtienne quelque chose de similaire pour mes accords et mes visas. En tout j'ai 9 colonnes "Services concernés" 9 colonnes "Accord" et 9 colonnes "Visa". Il faut donc que les éléments de la listbox ne soit plus dans la même cellule séparés par une virgule mais dans la même ligne séparé de par les deux colonnes "Accord" et "Visa".

J'espère que ma formulation est plus claire que le premier pavé incompréhensible que j'avais pondu et je vous remercie par avance de l'aide que vous pourrez m'apporter !
Bien à vous,
Erwan

 

[BOISGONTIER]

Bonsoir,

Option Compare Text
Dim nomtableau
Private Sub UserForm_Initialize()
  nomtableau = "produit"
  Me.enreg = Range(nomtableau).Rows.Count + 1
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Tbl = Range(nomtableau).Value
  Tri Tbl, LBound(Tbl), UBound(Tbl), 1
  Me.Recherche.List = Tbl
  For s = 1 To 4
    Me("Service" & s).List = [Tableau2].Value
  Next s
End Sub

Private Sub Recherche_Change()
  Me.enreg = Application.Match(Val(Me.Recherche), Range(nomtableau).Columns(1), 0)
  Me.Id = Me.Recherche
  For i = 2 To 3
    Me("TextBox" & i) = Range(nomtableau).Item(enreg, i)
  Next i
  Me.Textbox4 = Range(nomtableau).Item(enreg, 4)
  Me.Textbox5 = Range(nomtableau).Item(enreg, 5)
  Me.Textbox6 = Range(nomtableau).Item(enreg, 6)
  Me.Textbox7 = Range(nomtableau).Item(enreg, 7)
  For i = 9 To 11
    Me("TextBox" & i) = Range(nomtableau).Item(enreg, i)
  Next i
  '--- services
   For s = 1 To 4
    Me("service" & s) = Range(nomtableau).Item(enreg, 8 + (s - 1) * 3)
    Me("accord" & s) = Range(nomtableau).Item(enreg, 9 + (s - 1) * 3)
    Me("visa" & s) = Range(nomtableau).Item(enreg, 10 + (s - 1) * 3)
   Next s
End Sub

Private Sub B_valid_Click()
  enreg = Me.enreg
  Range(nomtableau).Item(enreg, 1) = Val(Me.Id)
  For i = 2 To 3
    Range(nomtableau).Item(enreg, i) = Me("TextBox" & i)
  Next i
  temp = Range(nomtableau).Item(enreg, 4): If IsDate(temp) Then temp = CDate(temp)
  Range(nomtableau).Item(enreg, 4) = temp
  temp = Range(nomtableau).Item(enreg, 5): If IsDate(temp) Then temp = CDate(temp)
  Range(nomtableau).Item(enreg, 5) = temp
  Range(nomtableau).Item(enreg, 6) = Me.Textbox6
  Range(nomtableau).Item(enreg, 7) = Me.Textbox7
  Range(nomtableau).Item(enreg, 35) = Me.TextBox11
  For i = 9 To 11
    Range(nomtableau).Item(enreg, i) = Me("TextBox" & i)
  Next i
  '-- services
   For s = 1 To 4
     Range(nomtableau).Item(enreg, 8 + (s - 1) * 3) = Me("service" & s)
     Range(nomtableau).Item(enreg, 9 + (s - 1) * 3) = Me("accord" & s)
     Range(nomtableau).Item(enreg, 10 + (s - 1) * 3) = Me("visa" & s)
   Next s
   raz
   UserForm_Initialize
End Sub

Private Sub B_sup_Click()
  If MsgBox("Etes vous sûr de supprimer " & Me.enreg & "?", vbYesNo) = vbYes Then
     Range(nomtableau).Rows(Me.enreg).Delete
     Me.Recherche.List = Range(nomtableau).Value
  End If
End Sub
Private Sub B_ajout_Click()
  raz
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Me.enreg = Range(nomtableau).Rows.Count + 1
End Sub
Sub raz()
  For i = 2 To 7
     Me("TextBox" & i) = ""
  Next i
  For i = 9 To 11
     Me("TextBox" & i) = ""
  Next i
  For s = 1 To 4
    Me("service" & s) = ""
    Me("accord" & s) = ""
    Me("visa" & s) = ""
  Next s
End Sub
Private Sub B_suivant_Click()
 If Me.Recherche.ListIndex < Me.Recherche.ListCount - 1 Then
   Me.Recherche.ListIndex = Me.Recherche.ListIndex + 1
  End If
End Sub

Private Sub b_précédent_Click()
  If Me.Recherche.ListIndex > 0 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex - 1
  End If
End Sub

Boisgontier

 

[Sparfell29]

Bonsoir merci beaucoup je regarde ca demain matin en arrivant au travail =D !