Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Sparfell29

XLDnaute Nouveau
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
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonsoir,

VB:
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
 

Pièces jointes

  • Arret de commercialisation modèle Forum2.xlsm
    352.9 KB · Affichages: 6
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…