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

Microsoft 365 Ajout de données

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
G

GClaire

XLDnaute Impliqué
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
 

Pièces jointes

Trier par date Trier par votes
CC

J'ai tant bien que mal avancé, lol

VB: 
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
 
Vote positif 0 Vote négatif
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 :

VB: 
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Question Question
Microsoft 365 Choix et export de données (Résolu)
Réponses
4
Affichages
874
GClaire
G
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
802
GClaire
G
G
  • Question Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
2 K
laurent950
G
  • Question Question
Microsoft 365 Export données d'une listview
Réponses
5
Affichages
640
GClaire
G
G
  • Question Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
878
GClaire
G
A
  • Résolu(e)
XL 2019 Créer une base de données à partir de plusieurs fichiers excel source
Réponses
7
Affichages
1 K
adrien786
A
  • Question Question
XL 2019 UserForm liste déroulante (cascade) avec ajout de données/modification
2 3
Réponses
38
Affichages
9 K
kinders59
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…