Microsoft 365 Export données d'une listview

GClaire · 17 Avril 2024

Hello le forum

L'histoire continue

Avec ce code j'exporte le contenue de ma Listview.

VB:

Private Sub CmdB_ImportQuestions_Click()
    Dim DerreLigne As Long
    Dim wsBase As Worksheet
    Dim selectedItem As ListItem
    
    ' Définir la feuille "Base"
    Set wsBase = ThisWorkbook.Sheets("Base")
    
    ' Trouver la dernière ligne utilisée dans la colonne Q de la feuille "Base"
    DerreLigne = wsBase.Cells(wsBase.Rows.Count, "Q").End(xlUp).Row
    
    ' Parcourir tous les éléments de la ListView "LsV_Import"
    For Each selectedItem In LsV_Import.ListItems
        ' Écrire les valeurs dans les colonnes spécifiées de la feuille "Base"
        wsBase.Cells(DerreLigne + 1, "Q").Value = selectedItem.Text
        wsBase.Cells(DerreLigne + 1, "R").Value = selectedItem.SubItems(1)
        wsBase.Cells(DerreLigne + 1, "S").Value = selectedItem.SubItems(2)
        wsBase.Cells(DerreLigne + 1, "T").Value = selectedItem.SubItems(3)
        wsBase.Cells(DerreLigne + 1, "A").Value = selectedItem.SubItems(4)
        wsBase.Cells(DerreLigne + 1, "J").Value = selectedItem.SubItems(4)
        wsBase.Cells(DerreLigne + 1, "U").Value = selectedItem.SubItems(4)
        wsBase.Cells(DerreLigne + 1, "B").Value = selectedItem.SubItems(5)
        wsBase.Cells(DerreLigne + 1, "K").Value = selectedItem.SubItems(5)
        wsBase.Cells(DerreLigne + 1, "V").Value = selectedItem.SubItems(5)
        wsBase.Cells(DerreLigne + 1, "C").Value = selectedItem.SubItems(6)
        wsBase.Cells(DerreLigne + 1, "L").Value = selectedItem.SubItems(6)
        wsBase.Cells(DerreLigne + 1, "W").Value = selectedItem.SubItems(6)
        wsBase.Cells(DerreLigne + 1, "D").Value = selectedItem.SubItems(7)
        wsBase.Cells(DerreLigne + 1, "M").Value = selectedItem.SubItems(7)
        wsBase.Cells(DerreLigne + 1, "X").Value = selectedItem.SubItems(7)
        wsBase.Cells(DerreLigne + 1, "E").Value = selectedItem.SubItems(8)
        wsBase.Cells(DerreLigne + 1, "N").Value = selectedItem.SubItems(8)
        wsBase.Cells(DerreLigne + 1, "Y").Value = selectedItem.SubItems(8)
        wsBase.Cells(DerreLigne + 1, "AA").Value = selectedItem.SubItems(9)
        wsBase.Cells(DerreLigne + 1, "AB").Value = selectedItem.SubItems(10)
        wsBase.Cells(DerreLigne + 1, "F").Value = ""
        wsBase.Cells(DerreLigne + 1, "G").Value = ""
        wsBase.Cells(DerreLigne + 1, "I").Value = ""
        wsBase.Cells(DerreLigne + 1, "O").Value = ""
        wsBase.Cells(DerreLigne + 1, "P").Value = ""
        wsBase.Cells(DerreLigne + 1, "Z").Value = ""
        
        ' Calculer la valeur pour la colonne H selon votre formule
        wsBase.Cells(DerreLigne + 1, "H").Formula = "=IF(B" & DerreLigne + 1 & "=K" & DerreLigne + 1 & ",""A"",IF(C" & DerreLigne + 1 & "=K" & DerreLigne + 1 & ",""B"",IF(D" & DerreLigne + 1 & "=K" & DerreLigne + 1 & ",""C"",IF(E" & DerreLigne + 1 & "=K" & DerreLigne + 1 & ",""D""))))"
        
        ' Passer à la prochaine ligne dans la feuille "Base"
        DerreLigne = DerreLigne + 1
    Next selectedItem

MsgBox "Données exportées"

End Sub

Bon jusque la je pense que ca le fait, lol

Mais ce que je n'arrive pas a faire, c'est tester que le numero si le numero de theme de la listview "selectedItem" il n'y a pas déjà des question avec ce theme en colonne "Q"

Et auquel cas continuer l'incrémentation du numéro de question en colonne "R"

Je vous met pour l'instant une impression écran, mais aucun soucis a mettre un fichier si besoin, pour le moment je retourne au taff.

je vous remercie, grandement

Passez une bonne et belle journée

G'Claire

ChTi160 · 17 Avril 2024

Bonjour G'Claire
première remarque : il faut éviter d'utiliser comme variable ,des termes faisant partis du langage vba(selectedItem)
de plus comment définis tu que la Ligne est Sélectionnée dans ta Boucle ?
exemple :

VB:

For i = 1 To LsV_Import.ListItems.Count    ' Vérifier si l'élément est sélectionné  
If LsV_Import.ListItems(i).Selected Then

Bonne Journée
Jean marie

GClaire · 17 Avril 2024

ChTi160 à dit:
Bonjour G'Claire
première remarque : il faut éviter d'utiliser comme variable ,des termes faisant partis du langage vba(selectedItem)
de plus comment définis tu que la Ligne est Sélectionnée dans ta Boucle ?
exemple :

VB:

For i = 1 To LsV_Import.ListItems.Count ' Vérifier si l'élément est sélectionné If LsV_Import.ListItems(i).Selected Then

Bonne Journée
Jean marie

Cc ChTi160

Bien content de te life depuis le temps.

De bons souvenirs d’un fichier qui tourne toujours, grâce à toi.

Pour répondre

Je ne me rappelais plus pour l’histoire des noms de variables (tu vois toujours à la ramasse, lol)

Et pour la sélection, VBA, doit savoir que je suis une burne, il le fait sans moi,

Merci

À bientôt.

G’Claire.

GClaire · 17 Avril 2024

Re le forum

J'ai fais un peu de ménage pour pouvoir mettre le classeur, si vous pouvez jeter un zyeux

J'espère qu'il n'y aura pas de bugg due a des trucs supprimés en trop

Merci trés trés trés beaucoup

Passez une belle et bonne journée.

G'Claire

GClaire · 19 Avril 2024

CC Le forum

Je ente tant bien que mal d'essayer de venir a bour de ette option d'import en masse, mais en vain

J'ai voulu m'inspirer d'un code que j'utilise pour exporter une question, mais dans le même principe

Code:

Private Sub CmdB_Ajouter_Click()
Dim ws As Worksheet
Dim DerrLigneTheme As Long
Dim wsListeDonnees As Worksheet
Dim i
Dim j As Long
Dim theme As String
Dim reponse As VbMsgBoxResult

Dim control As control
Dim MessageErreur As String
Dim missingControls As Boolean


' Définir les feuilles de calcul
Set ws = ThisWorkbook.Sheets("Base")
Set wsListeDonnees = ThisWorkbook.Sheets("Listes de donnees")


' Initialize the error message
MessageErreur = "Les champs suivants sont vides : " & vbCrLf
    
' Check each ComboBox and TextBox
For Each control In Me.Controls
    If TypeName(control) = "ComboBox" Or TypeName(control) = "TextBox" Then
        If control.Text = "" Then
            missingControls = True
            Select Case True
                Case control.Name = "CbX_Theme"
                    MessageErreur = MessageErreur & "- Thème non choisi." & vbCrLf
                    
                Case control.Name = "TxB_Question"
                    MessageErreur = MessageErreur & "- Champ Question non rempli." & vbCrLf
                    
                Case control.Name = "TxB_ReponseA"
                    MessageErreur = MessageErreur & "- Champ Réponse A non rempli." & vbCrLf
                    
                Case control.Name = "TxB_ReponseB"
                    MessageErreur = MessageErreur & "- Champ Réponse B non rempli." & vbCrLf
                    
                Case control.Name = "TxB_ReponseC"
                    MessageErreur = MessageErreur & "- Champ Réponse C non rempli." & vbCrLf
                    
                Case control.Name = "TxB_ReponseD"
                    MessageErreur = MessageErreur & "- Champ Réponse D non rempli." & vbCrLf
                    
                Case control.Name = "CbX_Categorie"
                    MessageErreur = MessageErreur & "- Catégorie non choisie." & vbCrLf
                    
                Case control.Name = "CbX_Niveau"
                    MessageErreur = MessageErreur & "- Niveau non choisie." & vbCrLf
                    
                Case control.Name = "CbX_Difficulte"
                    MessageErreur = MessageErreur & "- Difficulté non choisie." & vbCrLf
            End Select
        End If
    End If
Next control
    
'Si des champs sont non renseignés ou tous renseignés
If missingControls Then
        MsgBox MessageErreur, vbExclamation, "Champs requis"
Else
        MsgBox "Tous les champs sont remplis !"
        
' Récupérer la valeur sélectionnée dans le ComboBox "CbX_Theme"
theme = USF_AjoutQuestion.CbX_Theme.List(CbX_Theme.ListIndex, -0)

With ws
' Trouver la dernière ligne avec la valeur du ComboBox dans la colonne "S"
DerrLigneTheme = .Cells(.Rows.Count, "S").End(xlUp).Row

    For j = DerrLigneTheme To 1 Step -1
        If .Cells(j, "S").Value = theme Then
            ' Affichez ou utilisez la dernière ligne trouvée ici
            'MsgBox "La dernière valeur égale à " & theme & " est à la ligne " & j
            
            For i = DerrLigneTheme To 1 Step -1
                    If ws.Cells(i, "S").Value = theme Then
                        ' Insérer une nouvelle ligne après la dernière occurrence trouvée
                        .Rows(i + 1).Insert Shift:=xlDown
                         ' On ajout la formule dans la colonne "H"
                        .Cells(i + 1, "H").Formula = "=IF(B" & i + 1 & "=K" & i + 1 & ",""A"",IF(C" & i + 1 & "=K" & i + 1 & _
                                                ",""B"",IF(D" & i + 1 & "=K" & i + 1 & ",""C"",IF(E" & i + 1 & "=K" & i + 1 & ",""D""))))"
                         ' Copier la valeur du contrôle "TxB_Question" dans la colonne "S"
                        .Cells(i + 1, "Q").Value = USF_AjoutQuestion.TxBNumTheme.Value
                        ' Incrémenter la valeur de la colonne "R"
                        .Cells(i + 1, "R").Value = ws.Cells(i, "R").Value + 1
                        ' Incrémenter la valeur de la colonne "R"
                        .Cells(i + 1, "S").Value = theme
                        
                        ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                        .Cells(i + 1, "A").Value = USF_AjoutQuestion.TxB_Question.Value
                        ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                        .Cells(i + 1, "B").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                        ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                        .Cells(i + 1, "C").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                        ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                        .Cells(i + 1, "D").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                        ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                        .Cells(i + 1, "E").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                        
                         ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                        .Cells(i + 1, "J").Value = USF_AjoutQuestion.TxB_Question.Value
                        ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                        .Cells(i + 1, "K").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                        ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                        .Cells(i + 1, "L").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                        ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                        .Cells(i + 1, "M").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                        ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                        .Cells(i + 1, "N").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                      
                         ' Copier la valeur du contrôle "CbX_Niveau" dans la colonne "T"
                        .Cells(i + 1, "T").Value = USF_AjoutQuestion.CbX_Niveau.Value
                      
                      
                        ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                        .Cells(i + 1, "U").Value = USF_AjoutQuestion.TxB_Question.Value
                        ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                        .Cells(i + 1, "V").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                        ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                        .Cells(i + 1, "W").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                        ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                        .Cells(i + 1, "X").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                        ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                        .Cells(i + 1, "Y").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                        
                         ' Copier la valeur du contrôle "CbX_Difficulte" dans la colonne "AB"
                        .Cells(i + 1, "AB").Value = USF_AjoutQuestion.CbX_Difficulte.Value
                        
                        MsgBox "La question a été ajoutée avec succès.", vbInformation
                        ' Afficher la boîte de dialogue avec la question
                        reponse = MsgBox("JB, veux-tu ajouter une nouvelle question ?", vbQuestion + vbYesNo, "Ajout d'une nouvelle question")
                        
                        ' Vérifier la réponse de l'utilisateur
                        If reponse = vbYes Then
                            Unload Me
                            USF_AjoutQuestion.Show 0
                        Else
                            Unload Me
                        End If
                        Exit Sub
                    End If
                Next i
            Exit Sub
        End If
    Next j
    
    ' Si aucune valeur correspondante n'est trouvée
    MsgBox "Aucune question avec le " & theme & " n'a été trouvée." _
    & vbCr & "Nous ajoutons cette question a la fin de la fin de la Base de données", vbInformation
    
    'On cherche la dernière ligne vide de "S"
    DerrLigneTheme = .Cells(ws.Rows.Count, "S").End(xlUp).Row
    
        ' Vérifier si la valeur existe déjà
        If Not QuestionExists(TxB_Question.Value) Then
            ' Insérer la valeur dans la colonne B a E
            .Cells(DerrLigneTheme + 1, "A").Value = TxB_Question.Value
            .Cells(DerrLigneTheme + 1, "B").Value = TxB_ReponseA.Value
            .Cells(DerrLigneTheme + 1, "C").Value = TxB_ReponseB.Value
            .Cells(DerrLigneTheme + 1, "D").Value = TxB_ReponseC.Value
            .Cells(DerrLigneTheme + 1, "E").Value = TxB_ReponseD.Value
            .Cells(DerrLigneTheme + 1, "H").Formula = "=IF(B" & DerrLigneTheme + 1 & "=K" & DerrLigneTheme + 1 & _
                                                ",""A"",IF(C" & DerrLigneTheme + 1 & "=K" & DerrLigneTheme + 1 & _
                                                ",""B"",IF(D" & DerrLigneTheme + 1 & "=K" & DerrLigneTheme + 1 & _
                                                ",""C"",IF(E" & DerrLigneTheme + 1 & "=K" & DerrLigneTheme + 1 & ",""D""))))"
            .Cells(DerrLigneTheme + 1, "J").Value = TxB_Question.Value
            .Cells(DerrLigneTheme + 1, "K").Value = TxB_ReponseA.Value
            .Cells(DerrLigneTheme + 1, "L").Value = TxB_ReponseB.Value
            .Cells(DerrLigneTheme + 1, "M").Value = TxB_ReponseC.Value
            .Cells(DerrLigneTheme + 1, "N").Value = TxB_ReponseD.Value
            .Cells(DerrLigneTheme + 1, "Q").Value = CbX_Theme.List(CbX_Theme.ListIndex, -1)
            .Cells(DerrLigneTheme + 1, "R").Value = "1"
            .Cells(DerrLigneTheme + 1, "S").Value = CbX_Theme.List(CbX_Theme.ListIndex, 0)
            .Cells(DerrLigneTheme + 1, "T").Value = CbX_Niveau.List(CbX_Niveau.ListIndex, 0)
            .Cells(DerrLigneTheme + 1, "U").Value = TxB_Question.Value
            .Cells(DerrLigneTheme + 1, "V").Value = TxB_ReponseA.Value
            .Cells(DerrLigneTheme + 1, "W").Value = TxB_ReponseB.Value
            .Cells(DerrLigneTheme + 1, "X").Value = TxB_ReponseC.Value
            .Cells(DerrLigneTheme + 1, "Y").Value = TxB_ReponseD.Value
            .Cells(DerrLigneTheme + 1, "AA").Value = CbX_Categorie.List(CbX_Categorie.ListIndex, 0)
            .Cells(DerrLigneTheme + 1, "AB").Value = CbX_Difficulte.List(CbX_Difficulte.ListIndex, 0)
    
        Set wsListeDonnees = Nothing
        Set ws = Nothing
        
        Else
            MsgBox "La question existe déjà.", vbExclamation
        End If
    End With
    
    ' Afficher la boîte de dialogue avec la question
    reponse = MsgBox("JB, veux-tu ajouter une nouvelle question ?", vbQuestion + vbYesNo, "Ajout d'une nouvelle question")
    
    ' Vérifier la réponse de l'utilisateur
    If reponse = vbYes Then
        Unload Me
        USF_AjoutQuestion.Show 0
    Else
        Unload Me
    End If
End If
End Sub

Private Function QuestionExists(question As String) As Boolean
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    ' Définir la feuille de calcul
    Set ws = ThisWorkbook.Sheets("Base")
    
    ' Rechercher dans la colonne B si le thème existe déjà
    Set rng = ws.Range("A:A")
    Set cell = rng.Find(What:=question, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not cell Is Nothing Then
        QuestionExists = True
    Else
        QuestionExists = False
    End If
End Function

Je test si le N° de thème "Récupérer d'un (combobox) existe dans la feuille "Base" colonne "Q"

S'il existe, je l'envoie dans la feuille, en dessous de la dernière ligne trouvée de ce N° de theme et j'incrémente le N° de question du thème de 1

S'il n'existe pas, je l'envoie en fin de feuille et met le N° de question a 1

Pour l'ajout d'une question cela fonctionne plustot bien.

J'ai modifié le code comme suis,

VB:

Private Sub CmdB_ImportQuestions_Click()

Dim ws As Worksheet
Dim DerrLigneTheme As Long
Dim selectedItem As ListItem
Dim i
Dim j As Long
Dim theme As String
Dim reponse As VbMsgBoxResult


' Définir les feuilles de calcul
Set ws = ThisWorkbook.Sheets("Base")


        
' Récupérer la valeur sélectionnée dans la listeview
theme = USF_ImportTheme.LsV_Import.selectedItem.Text

With ws
' Trouver la dernière ligne avec la valeur de la listview dans la colonne "S"
DerrLigneTheme = .Cells(.Rows.Count, "S").End(xlUp).Row

    For j = DerrLigneTheme To 1 Step -1
        If .Cells(j, "T").Value = theme Then
            ' Affichez ou utilisez la dernière ligne trouvée ici
            MsgBox "La dernière valeur égale à " & theme & " est à la ligne " & j
            
            For i = DerrLigneTheme To 1 Step -1
                    If ws.Cells(i, "T").Value = theme Then
                        ' Insérer une nouvelle ligne après la dernière occurrence trouvée
                        .Rows(i + 1).Insert Shift:=xlDown
                        For Each selectedItem In LsV_Import.ListItems
                            .Cells(i, "A").Value = selectedItem.SubItems(4)
                            .Cells(i, "B").Value = selectedItem.SubItems(5)
                            .Cells(i, "C").Value = selectedItem.SubItems(6)
                            .Cells(i, "D").Value = selectedItem.SubItems(7)
                            .Cells(i, "E").Value = selectedItem.SubItems(8)
                            .Cells(i, "H").Formula = "=IF(B" & i & "=K" & i & ",""A"",IF(C" & i & "=K" & i & ",""B"",IF(D" & i & "=K" & i & ",""C"",IF(E" & i & "=K" & i & ",""D""))))"
                            .Cells(i, "J").Value = selectedItem.SubItems(4)
                            .Cells(i, "K").Value = selectedItem.SubItems(5)
                            .Cells(i, "L").Value = selectedItem.SubItems(6)
                            .Cells(i, "M").Value = selectedItem.SubItems(7)
                            .Cells(i, "N").Value = selectedItem.SubItems(8)
                            .Cells(i, "Q").Value = selectedItem.Text
                            .Cells(i, "R").Value = .Cells(i, "R").Value + 1
                            .Cells(i, "S").Value = selectedItem.SubItems(2)
                            .Cells(i, "T").Value = selectedItem.SubItems(3)
                            .Cells(i, "U").Value = selectedItem.SubItems(4)
                            .Cells(i, "V").Value = selectedItem.SubItems(5)
                            .Cells(i, "W").Value = selectedItem.SubItems(6)
                            .Cells(i, "X").Value = selectedItem.SubItems(7)
                            .Cells(i, "Y").Value = selectedItem.SubItems(8)
                            .Cells(i, "AA").Value = selectedItem.SubItems(9)
                            .Cells(i, "AB").Value = selectedItem.SubItems(10)
                            
                            i = i + 1
                            
                        Next selectedItem
                        
                        Else
                        
                        For Each selectedItem In LsV_Import.ListItems
                            .Cells(i, "A").Value = selectedItem.SubItems(4)
                            .Cells(i, "B").Value = selectedItem.SubItems(5)
                            .Cells(i, "C").Value = selectedItem.SubItems(6)
                            .Cells(i, "D").Value = selectedItem.SubItems(7)
                            .Cells(i, "E").Value = selectedItem.SubItems(8)
                            .Cells(i, "H").Formula = "=IF(B" & i & "=K" & i & ",""A"",IF(C" & i & "=K" & i & ",""B"",IF(D" & i & "=K" & i & ",""C"",IF(E" & i & "=K" & i & ",""D""))))"
                            .Cells(i, "J").Value = selectedItem.SubItems(4)
                            .Cells(i, "K").Value = selectedItem.SubItems(5)
                            .Cells(i, "L").Value = selectedItem.SubItems(6)
                            .Cells(i, "M").Value = selectedItem.SubItems(7)
                            .Cells(i, "N").Value = selectedItem.SubItems(8)
                            .Cells(i, "Q").Value = selectedItem.Text
                            .Cells(i, "R").Value = selectedItem.SubItems(1)
                            .Cells(i, "S").Value = selectedItem.SubItems(2)
                            .Cells(i, "T").Value = selectedItem.SubItems(3)
                            .Cells(i, "U").Value = selectedItem.SubItems(4)
                            .Cells(i, "V").Value = selectedItem.SubItems(5)
                            .Cells(i, "W").Value = selectedItem.SubItems(6)
                            .Cells(i, "X").Value = selectedItem.SubItems(7)
                            .Cells(i, "Y").Value = selectedItem.SubItems(8)
                            .Cells(i, "AA").Value = selectedItem.SubItems(9)
                            .Cells(i, "AB").Value = selectedItem.SubItems(10)
                            
                            i = i + 1
                            
                        Next selectedItem
                        
                        MsgBox "La question a été ajoutée avec succès.", vbInformation
                        ' Afficher la boîte de dialogue avec la question
                        reponse = MsgBox("JB, veux-tu ajouter un nouveau thème ?", vbQuestion + vbYesNo, "Ajout d'un nouveau thème")
                        
                        ' Vérifier la réponse de l'utilisateur
                        If reponse = vbYes Then
                            Unload Me
                            USF_ImportTheme.Show 0
                        Else
                            Unload Me
                        End If
                        Exit Sub
                    End If
                Next i
            Exit Sub
        End If
    Next j
    
End With
End Sub

Mai srien ne se passe, je suis passé en mode pas a pas, pour voir ou cela s'arrete, je ne passe même pas le message qui dit : MsgBox "La dernière valeur égale à " & theme & " est à la ligne " & j

Voili

Merci

Bonne soirée, G'Claire noir pour le coup, lol

GClaire · 22 Avril 2024

Hello le fofo

Bon j'ai tant bien que mal réussi a faire ce que je voulais de cette manière :

VB:

Private Sub CmdB_ImportQuestions_Click()
Dim ws As Worksheet
Dim i As Long, j As Long, DernLigne As Long
Dim DernVal As Variant

'Déterminer la dernière ligne utilisée en colonne Q
Set ws = ThisWorkbook.Sheets("Base")
DernLigne = ws.Cells(ws.Rows.Count, "Q").End(xlUp).Row

'Parcourir les éléments de la ListView
For i = 1 To Me.LsV_Import.ListItems.Count
    'Rechercher la dernière occurrence de la valeur de la colonne Q dans la colonne Q de la feuille "Base"
    For j = DernLigne To 5 Step -1
        If ws.Cells(j, "Q").Value = Me.LsV_Import.ListItems(i).Text Then
            DernVal = j
            Exit For
        End If
    Next j
    'Si une valeur identique est trouvée
    If Not IsEmpty(DernVal) Then
        ' Insérer les données à la suite de la dernière valeur identique trouvée
        ws.Rows(DernVal + 1).Insert Shift:=xlDown
        ' Remplir les colonnes avec les données de l'item de la ListView
        ws.Cells(DernVal + 1, "A").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernVal + 1, "B").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernVal + 1, "C").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernVal + 1, "D").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernVal + 1, "E").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernVal + 1, "H").Value = "=IF(B" & DernVal + 1 & "=K" & DernVal + 1 & ",""A"",IF(C" & DernVal + 1 & "=K" & DernVal + 1 & ",""B"",IF(D" & DernVal + 1 & "=K" & DernVal + 1 & ",""C"",IF(E" & DernVal + 1 & "=K" & DernVal + 1 & ",""D""))))"
        ws.Cells(DernVal + 1, "J").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernVal + 1, "K").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernVal + 1, "L").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernVal + 1, "M").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernVal + 1, "N").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernVal + 1, "Q").Value = Me.LsV_Import.ListItems(i).Text
        ws.Cells(DernVal + 1, "R").Value = ws.Cells(DernVal, "R").Value + 1
        ws.Cells(DernVal + 1, "S").Value = Me.LsV_Import.ListItems(i).ListSubItems(2).Text
        ws.Cells(DernVal + 1, "T").Value = Me.LsV_Import.ListItems(i).ListSubItems(3).Text
        ws.Cells(DernVal + 1, "U").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernVal + 1, "V").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernVal + 1, "W").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernVal + 1, "X").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernVal + 1, "Y").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernVal + 1, "AA").Value = Me.LsV_Import.ListItems(i).ListSubItems(9).Text
        ws.Cells(DernVal + 1, "AB").Value = Me.LsV_Import.ListItems(i).ListSubItems(10).Text
        ' Mise à jour de la dernière ligne utilisée
        DernLigne = DernLigne + 1
    Else
        ' Si aucune valeur identique n'est trouvée, envoyer les données à la dernière ligne du tableau
        DernLigne = DernLigne + 1
        ' Remplir les colonnes avec les données de l'item de la ListView
        ws.Cells(DernLigne, "A").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernLigne, "B").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernLigne, "C").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernLigne, "D").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernLigne, "E").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernLigne, "H").Value = "=IF(B" & DernLigne + 1 & "=K" & DernLigne + 1 & ",""A"",IF(C" & DernLigne + 1 & "=K" & DernLigne + 1 & ",""B"",IF(D" & DernLigne + 1 & "=K" & DernLigne + 1 & ",""C"",IF(E" & DernLigne + 1 & "=K" & DernLigne + 1 & ",""D""))))"
        ws.Cells(DernLigne, "J").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernLigne, "K").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernLigne, "L").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernLigne, "M").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernLigne, "N").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernLigne, "Q").Value = Me.LsV_Import.ListItems(i).Text
        ws.Cells(DernLigne, "R").Value = Me.LsV_Import.ListItems(i).ListSubItems(1).Text
        ws.Cells(DernLigne, "S").Value = Me.LsV_Import.ListItems(i).ListSubItems(2).Text
        ws.Cells(DernLigne, "T").Value = Me.LsV_Import.ListItems(i).ListSubItems(3).Text
        ws.Cells(DernLigne, "U").Value = Me.LsV_Import.ListItems(i).ListSubItems(4).Text
        ws.Cells(DernLigne, "V").Value = Me.LsV_Import.ListItems(i).ListSubItems(5).Text
        ws.Cells(DernLigne, "W").Value = Me.LsV_Import.ListItems(i).ListSubItems(6).Text
        ws.Cells(DernLigne, "X").Value = Me.LsV_Import.ListItems(i).ListSubItems(7).Text
        ws.Cells(DernLigne, "Y").Value = Me.LsV_Import.ListItems(i).ListSubItems(8).Text
        ws.Cells(DernLigne, "AA").Value = Me.LsV_Import.ListItems(i).ListSubItems(9).Text
        ws.Cells(DernLigne, "AB").Value = Me.LsV_Import.ListItems(i).ListSubItems(10).Text
    End If
Next i

FormaterLignes

MsgBox "Données exportées", vbInformation

End Sub

Le petit soucis que je rencontre.

La faut que je gère mes MFC, qui ne s'appliquent plus dans mon fichier, mais dans celui-la si...

Merci

G'Claire

Microsoft 365 Export données d'une listview

GClaire

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

GClaire

XLDnaute Occasionnel

GClaire

XLDnaute Occasionnel

Pièces jointes

GClaire

XLDnaute Occasionnel

GClaire

XLDnaute Occasionnel

Pièces jointes

Discussions similaires