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

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

N

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...
Trier par date Trier par votes

mapomme

XLDnaute Barbatruc
Supporter XLD
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:
Vote positif 0 Vote négatif
Solution
N

NONO14

XLDnaute Impliqué
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: 3
Vote positif 0 Vote négatif

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:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Remplir une ComboBox à 3 colonnes avec les données d'un TS
4 5 6
Réponses
78
Affichages
1 K
Dudu2
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
273
NONO14
N
N
  • Résolu(e)
Microsoft 365 Supprimer de la liste d'une Combo les données déjà présentes dans une colonne d'un TS
2
Réponses
18
Affichages
483
NONO14
N
N
  • Question
Microsoft 365 Alimenter une Combo Active X inséré dans une feuille de calcul
Réponses
3
Affichages
99
NONO14
N
N
  • Résolu(e)
Microsoft 365 Récupération données ListBox dans TextBox
2 3
Réponses
35
Affichages
466
NONO14
N
N
  • Résolu(e)
Microsoft 365 Modification impossible d'une TextBox
2 3 4
Réponses
56
Affichages
1 K
NONO14
N
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
17 18 19
Réponses
277
Affichages
66 K
NONO14
N
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
130
sebastien176
S
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
652
Messan
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…