Microsoft 365 Ajout de données

Créer une discussion
Répondre

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é
Supporter XLD
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)

1712523451440.png


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.

1712696236691.png


Une idée ou je bug?

Merci beaucoup.

G'Claire
 
Vote positif 0 Vote négatif
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
670
GClaire
G
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
504
GClaire
G
G
  • Question Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
2 K
laurent950
laurent950
G
  • Question Question
Microsoft 365 Export données d'une listview
Réponses
5
Affichages
498
GClaire
G
L
  • Question Question
XL 2021 Transformer des données verticales en horizontales et mettre à jour un graphique automatiquement
Réponses
11
Affichages
116
Leina
L
G
  • Question Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
723
GClaire
G
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
523
GClaire
G
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
82
vgendron
vgendron
D
  • Résolu(e)
XL 2021 VBA Formulaire
2
Réponses
27
Affichages
1 K
delsart59
D
Roseline
  • Résolu(e)
Microsoft 365 Ajout d'onglet par VBA et entête de colonnes
2
Réponses
17
Affichages
991
Roseline
Roseline
A
  • Question Question
XL 2021 Automatiser la génération de documents Word à partir d’Excel avec VBA
Réponses
12
Affichages
273
ali591
A
A
  • Résolu(e)
XL 2016 Plage de données fixes pour calcul dans formule
Réponses
3
Affichages
401
sylvanu
sylvanu
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
816
Pac41240
P
J
  • Question Question
Microsoft 365 Publipostage avec selection de données
Réponses
2
Affichages
349
.jakob@gmail.com
J
A
  • Question Question
XL pour MAC nettoyage et tri de données
2
Réponses
24
Affichages
1 K
agnesd
A
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
82
piga25
piga25
oguruma
POWERQUERY :: Ajout d'une colonne avec calculs multiples & TCD à l'issue des calculs
Réponses
0
Affichages
236
oguruma
oguruma
C
  • Résolu(e)
formulaire de saisie
2 3
Réponses
41
Affichages
3 K
Caso
C
M
  • Question Question
XL 2016 VBA - Traitement de données avec valeurs identiques dans un dictionnaire
2
Réponses
28
Affichages
2 K
Mak_tarmak
M
A
  • Résolu(e)
Microsoft 365 Référence automatique de tableaux structurés
Réponses
12
Affichages
942
AlexiaC
A
Retour