Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,
Dans un formulaire UfGestTemps je saisi des données dans des TextBox que je transfère dans un TS en cliquant sur le bouton "Valide".
Les données sont bien transférées, mais pas au bon endroit puisqu'elles écrasent la ligne des en-têtes, hors elles devraient être en-dessous.
Je ne comprends pas ce qui se passe puisque j'ai déjà utilisé ce code et il fonctionnait, mais là... J'ai dû zapper quelque chose.
Pouvez-vous m'éclairer s'il vous plaît ?
Je vous en remercie par avance.
VB:
Private Sub But_Valider_Click()
Dim Ctrl As Control
Application.ScreenUpdating = False

'On transfére les données dans la feuille "Liste_agents"
'On déprotège la feuille
    DeProtege ("Liste_agents")
        
'On cherche dans la colonne 1 si le code existe déjà
'Si c'est le cas un message annonce que l'employé(e) existe déjà
'Sinon, on crée une nouvelle ligne pour inscrire l'employé(e)
        With Sheets("Liste_agents").ListObjects("t_Noms")
            Set Trouve = .ListColumns(1).Range.Find(Me.Txt_Code, lookat:=xlWhole)
                If Not Trouve Is Nothing Then
                    MsgBox "Cet(te) employé(e) existe déjà !"
            Exit Sub
                Else
                    .ListRows.Add
                        LastlLine = .ListRows.Count
                            .DataBodyRange(LastLine, 1) = Me.Txt_Code.Value 'Le code dans la 1ère colonne
                            .DataBodyRange(LastLine, 2) = Me.Txt_Nom.Value 'Le NOM dans la 2ème colonne
                            .DataBodyRange(LastLine, 3) = Me.Txt_Prénom.Value 'Le Prénom dans la 3ème colonne
                            .DataBodyRange(LastLine, 4) = Me.Txt_Temps.Value 'Le temps de travail dans la 4ème colonne
                End If
        End With
        
 'Dans la feuille les colonnes sont en largeur automatique
        Sheets("Liste_agents").Columns.AutoFit
    
'On reprotège la feuille
    Protege ("Liste_agents")
    
'On efface les données se trouvant dans les TextBox du formulaire
    For Each Ctrl In Me.MultiPage1.Pages(0).Controls
        Select Case TypeName(Ctrl)
            Case "TextBox"
                Ctrl.Value = ""
        End Select
    Next Ctrl
    
'La TextBox Txt_Nom prend le focus
    Me.Txt_Nom.SetFocus

End Sub
 
Solution
Bonjour NONO14 :),

Désolé, il n'y a pas de classeur donc pas pu tester le code.

Pour s'en inspirer, j'aurais pu pondre un code du genre :
VB:
Dim lsto As ListObject
   'bla bla bla
      Set lsto = Sheets("Liste_agents").ListObjects("t_Noms")
      Set trouve = lsto.ListColumns(1).Range.Find("CodeAAA", lookat:=xlWhole, MatchCase:=False)
      If Not trouve Is Nothing Then MsgBox "CodeAAA" & "  :    Cet employé existe déjà.", vbCritical: Exit Sub
      lsto.ListRows.Add
      With lsto.ListRows(lsto.ListRows.Count)
         .Range(1) = "CodeAAA"
         .Range(2) = "NomAAA"
         .Range(3) = "PrénomA"
         .Range(4) = "DuréeAAA"
      End With
      MsgBox "CodeAAA" & " :    Cet employé a été intégré.", vbInformation
   'bla bla...

mapomme

XLDnaute Barbatruc
Bonjour NONO14 :),

Désolé, il n'y a pas de classeur donc pas pu tester le code.

Pour s'en inspirer, j'aurais pu pondre un code du genre :
VB:
Dim lsto As ListObject
   'bla bla bla
      Set lsto = Sheets("Liste_agents").ListObjects("t_Noms")
      Set trouve = lsto.ListColumns(1).Range.Find("CodeAAA", lookat:=xlWhole, MatchCase:=False)
      If Not trouve Is Nothing Then MsgBox "CodeAAA" & "  :    Cet employé existe déjà.", vbCritical: Exit Sub
      lsto.ListRows.Add
      With lsto.ListRows(lsto.ListRows.Count)
         .Range(1) = "CodeAAA"
         .Range(2) = "NomAAA"
         .Range(3) = "PrénomA"
         .Range(4) = "DuréeAAA"
      End With
      MsgBox "CodeAAA" & " :    Cet employé a été intégré.", vbInformation
   'bla bla bla
 
Dernière édition:

NONO14

XLDnaute Impliqué
Bonjour NONO14 :),

Désolé, il n'y a pas de classeur donc pas pu testé le code.

Pour s'en inspirer, j'aurais pu pondre un code du genre :
VB:
Dim lsto As ListObject, derlig&
'bla bla bla
   Set lsto = Sheets("Liste_agents").ListObjects("t_Noms")
   Set trouve = lsto.ListColumns(1).Range.Find("CodeAAA", lookat:=xlWhole, MatchCase:=False)
   If Not trouve Is Nothing Then MsgBox "CodeAAA" & "  :    Cet employé existe déjà.", vbCritical: Exit Sub
   lsto.ListRows.Add
   derlig = lsto.ListRows.Count
   With lsto.ListRows(derlig)
      .Range(1) = "CodeAAA"
      .Range(2) = "NomAAA"
      .Range(3) = "PrénomA"
      .Range(4) = "DuréeAAA"
   End With
   MsgBox "CodeAAA" & " :    Cet employé a été intégré.", vbInformation
'bla bla bla
Bonjour mapomme,
Dans la précipitation j'ai oublié de le joindre. Toutes mes excuses.
Je pense avoir résolu mon problème avec ce code. Mais peut-être peut-on faire mieux.
Je joins également le fichier
VB:
Private Sub But_Valider_Click()
Dim Ctrl As Control
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim NewRow As ListRow

Application.ScreenUpdating = False

'Définir la feuille et le TS
    Set Ws = ThisWorkbook.Sheets("Liste_agents")
    Set Tbl = Ws.ListObjects("t_Noms")
'On transfére les données dans la feuille "Liste_agents"
'On déprotège la feuille
    
    DeProtege ("Liste_agents")
        
'On cherche dans la colonne 1 si le code existe déjà
'Si c'est le cas un message annonce que l'employé(e) existe déjà
        With Tbl
            Set Trouve = .ListColumns(1).Range.Find(Me.Txt_Code, lookat:=xlWhole)
                If Not Trouve Is Nothing Then
                    MsgBox "Cet(te) employé(e) existe déjà !"
            Exit Sub
                Else
'On ajoute une nouvelle ligne au tableau
                    Set NewRow = Tbl.ListRows.Add
'On transfère les donnée vers le TS
                        With NewRow
                            .Range(1, 1) = Me.Txt_Code.Value 'Le code dans la 1ère colonne
                            .Range(1, 2) = Me.Txt_Nom.Value 'Le NOM dans la 2ème colonne
                            .Range(1, 3) = Me.Txt_Prénom.Value 'Le Prénom dans la 3ème colonne
                            .Range(1, 4) = Me.Txt_Temps.Value 'Le temps de travail dans la 4ème colonne
                        End With
        
 'Dans la feuille les colonnes sont en largeur automatique
        Sheets("Liste_agents").Columns.AutoFit
    
'On reprotège la feuille
    Protege ("Liste_agents")
    
'On efface les données se trouvant dans les TextBox du formulaire
    For Each Ctrl In Me.MultiPage1.Pages(0).Controls
        Select Case TypeName(Ctrl)
            Case "TextBox"
                Ctrl.Value = ""
        End Select
    Next Ctrl
    
'La TextBox Txt_Nom prend le focus
    Me.Txt_Nom.SetFocus
End If
End With
End Sub
 

Pièces jointes

  • GestPersonnnel (3).xlsm
    496.6 KB · Affichages: 6

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Peut-être faudrait-il commencer par tester si le DataBodyRange existe ?

Et n'hésite pas à utiliser une indentation correcte, ton code n'en sera que plus lisible et donc sa maintenance en sera simplifiée. 😉


[edit] Je vois que tu dis avoir résolu ton problème. 👍👏 [/edit]

[edit2] Deux With sans rapport imbriqués, apparemment ça tombe en marche, mais au niveau logique il vaudrait sûrement mieux éviter. [/edit2]
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
315 118
Messages
2 116 424
Membres
112 745
dernier inscrit
mcanas