Microsoft 365 Ajout de données

[GClaire]

Hello le forum

Encore besoin d'un coup de pouce.

Toujours pour la petite appli (Pour ces quizz) pour mon ami

Sur ce fichier, j'ai ajouté la possibilité de rajouter dans la base une question, avec les infos qui vont avec (Question, Theme, les réponses, le niveau, la catégorie et la difficulté. je me suis abstenu des tagg car je ne savais pas trop comment le gérer)

L'ajout pour le moment se fait correctement à la dernière ligne, mais ce que je souhaiterai :

1) Que cela se mette a la fin de la plage du thème choisis
2) Que cela incrémente de la dernière question du theme +1
3) Que la formule en colonne "H" (=SI(B5003=K5003;"A";SI(C5003=K5003;"B";SI(D5003=K5003;"C";SI(E5003=K5003;"D"))))) soit inclus et change suivant sa position dans la feuille

Es-ce possible?


Merci beaucoup a vous pour l'aide apporté.

Bonne soirée, G'Claire

 

[GClaire]

CC

J'ai tant bien que mal avancé, lol

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
    

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

' Récupérer la valeur sélectionnée dans le ComboBox "CbX_Theme"
theme = USF_AjoutQuestion.CbX_Theme.List(CbX_Theme.ListIndex, -0)

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

For j = DerrLigneTheme To 1 Step -1
    If ws.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
                    ws.Rows(i + 1).Insert Shift:=xlDown
                     ' On ajout la formule dans la colonne "H"
            ws.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"
                    ws.Cells(i + 1, "Q").Value = USF_AjoutQuestion.TxBNumTheme.Value
                    ' Incrémenter la valeur de la colonne "R"
                    ws.Cells(i + 1, "R").Value = ws.Cells(i, "R").Value + 1
                    ' Incrémenter la valeur de la colonne "R"
                    ws.Cells(i + 1, "S").Value = theme
                    
                    ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                    ws.Cells(i + 1, "A").Value = USF_AjoutQuestion.TxB_Question.Value
                    ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                    ws.Cells(i + 1, "B").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                    ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                    ws.Cells(i + 1, "C").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                    ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                    ws.Cells(i + 1, "D").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                    ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                    ws.Cells(i + 1, "E").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                    
                     ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                    ws.Cells(i + 1, "J").Value = USF_AjoutQuestion.TxB_Question.Value
                    ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                    ws.Cells(i + 1, "K").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                    ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                    ws.Cells(i + 1, "L").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                    ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                    ws.Cells(i + 1, "M").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                    ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                    ws.Cells(i + 1, "N").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                  
                     ' Copier la valeur du contrôle "CbX_Niveau" dans la colonne "T"
                    ws.Cells(i + 1, "T").Value = USF_AjoutQuestion.CbX_Niveau.Value
                  
                  
                    ' Copier la valeur du contrôle "TxB_Question" dans la colonne "U"
                    ws.Cells(i + 1, "U").Value = USF_AjoutQuestion.TxB_Question.Value
                    ' Copier la valeur du contrôle "TxB_ReponseA" dans la colonne "V"
                    ws.Cells(i + 1, "V").Value = USF_AjoutQuestion.TxB_ReponseA.Value
                    ' Copier la valeur du contrôle "TxB_ReponseB" dans la colonne "W"
                    ws.Cells(i + 1, "W").Value = USF_AjoutQuestion.TxB_ReponseB.Value
                    ' Copier la valeur du contrôle "TxB_ReponseC" dans la colonne "X"
                    ws.Cells(i + 1, "X").Value = USF_AjoutQuestion.TxB_ReponseC.Value
                    ' Copier la valeur du contrôle "TxB_QuestionD" dans la colonne "Y"
                    ws.Cells(i + 1, "Y").Value = USF_AjoutQuestion.TxB_ReponseD.Value
                    
                     ' Copier la valeur du contrôle "CbX_Difficulte" dans la colonne "AB"
                    ws.Cells(i + 1, "AB").Value = USF_AjoutQuestion.CbX_Difficulte.Value
                    
                    
                    MsgBox "La nouvelle ligne a été insérée avec succès après la ligne " & i
                    Exit Sub
                End If
            Next i
        Exit Sub
    End If
Next j

' Si aucune valeur correspondante n'est trouvée
MsgBox "Aucune valeur correspondante à " & theme & " n'a été trouvée dans la colonne S.", vbInformation

'On cherche la dernière ligne vide de "S"
DerrLigneTheme = ws.Cells(ws.Rows.Count, "S").End(xlUp).Row

' Vérifier si la valeur existe déjà
If Not QuestionExists(TxB_Question.Value) Then
    
    With ws
        ' 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 & "=K" & DerrLigneTheme & ",""A"",IF(C" & DerrLigneTheme & "=K" & DerrLigneTheme & _
                                            ",""B"",IF(D" & DerrLigneTheme & "=K" & DerrLigneTheme & ",""C"",IF(E" & DerrLigneTheme & "=K" & DerrLigneTheme & ",""D""))))"
        
        .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, "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, "S").Value = CbX_Theme.List(CbX_Theme.ListIndex, 0)
        .Cells(DerrLigneTheme + 1, "T").Value = CbX_Niveau.List(CbX_Niveau.ListIndex, 0)
        .Cells(DerrLigneTheme + 1, "AA").Value = CbX_Categorie.List(CbX_Categorie.ListIndex, 0)
        .Cells(DerrLigneTheme + 1, "AB").Value = CbX_Difficulte.List(CbX_Difficulte.ListIndex, 0)
    End With
    
Set wsListeDonnees = Nothing
Set ws = Nothing

    MsgBox "La question a été ajoutée avec succès.", vbInformation
Else
    MsgBox "La question existe déjà.", vbExclamation
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

Il y a peut être façon d'optimiser, hihi

Merci

G'Claire

 

[GClaire]

Hello le fofo

Tout fonctionne presque bien, lol

Je voudrais mettre un test pour voir les controls qui ne sont pa srempli et les liste non pas par le nom, mais par leur désignation.

Voici ce que j'ai (Il n'y a pas tous les controles dans le test :

Private Sub CommandButton1_Click()

Dim control As control
Dim MessageErreur As String
Dim ControlsManquants As Boolean

'Message
MessageErreur = "Les champs suivants sont vides : " & vbCrLf & vbCrLf

'On Scan tous les controls et affiche dans le message les controls vides
For Each control In Me.Controls
    If TypeName(control) = "ComboBox" Or TypeName(control) = "TextBox" Then
        If control.Value = "" Then
            ControlsManquants = 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 = "CbX_Categorie"
                    MessageErreur = MessageErreur & "- Catégorie non choisie." & vbCrLf
            End Select
        End If
    End If
Next control

'Control message
If ControlsManquants Then
    MsgBox MessageErreur, vbExclamation, "Champs requis"
Else
    MsgBox "Tous les champs sont remplis !"
End If

End Sub

Ce que je ne comprends pas c'est que cela détecte a priori des contrôles vides, et pourtant il y'a en a pas.

Une idée ou je bug?

Merci beaucoup.

G'Claire

 

[GClaire]

Re

Je vienne de faire un test et a priori cela recherche dans les labels (Je ne sais comment ne pas prendre en compte cela)

Serait-cela le soucis?

Merci

G'Claire