XL 2016 Pousser les données de l'Userform dans une nouvelle ligne de tableau

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
S

Sparfell29

XLDnaute Nouveau
Bonjour à tous,
J'ai codé ces formulaires de façon à ce qu'à l'issue de la saisie des données, en cliquant sur "Validation" on vienne mettre les données dans une nouvelle ligne du tableau. Cela fonctionnait sans aucun problème jusqu'à ce qu'il ne se passe... et bien rien du tout. D'après les utilisateurs personne n'a touché à quoi que ce soit. Cependant tous mes nouveaux ajouts se font en dehors de mon tableau désormais et ne sont donc pas pris en compte dans mon menu déroulant de recherche...
Je suis débutant en VBA et je ne comprends pas pourquoi du jour au lendemain un code fonctionnel se serait mis à fonctionner différemment.
J'ai dit à ma tutrice que de toute manière je n'étais pas informaticien et qu'il ne fallait pas mettre en fonction mes applis si nous n'étions pas capable d'en assurer la maintenance... Je suis profondément dépité par
1) le fait que cela ne fonctionne plus alors que j'y suis depuis le début de mon stage et que j'étais très heureux d'avoir réussi à faire cela.
2) le fait que je n'arrive pas à comprendre d'où vient la défaillance.
Pourriez-vous m'aider à ne serait-ce qu'identifier le problème quitte à ce que je m'en débrouille après ?

Juridique :
VB: 
Option Compare Text
Dim nomtableau


'Initialisation du formulaire
Private Sub UserForm_Initialize()
  nomtableau = "Contrat"
  Me.enreg = Range(nomtableau).Rows.Count + 1
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Tbl = Range(nomtableau).Value
  Tri Tbl, LBound(Tbl), UBound(Tbl), 1
  Me.Recherche.List = Tbl
 
  ' déprotection de la feuille "Produits" à éditer
  Sheets("Contrats").Unprotect Password:="iknowvba"
 
End Sub
Private Sub Recherche_Change()
  Me.enreg = Application.Match(Val(Me.Recherche), Range(nomtableau).Columns(1), 0)
  Me.Id = Me.Recherche
  For I = 2 To 15
    Me("TextBox" & I) = Range(nomtableau).Item(enreg, I)
  Next I

End Sub
Private Sub B_valid_Click()
  enreg = Me.enreg
  Range(nomtableau).Item(enreg, 1) = Val(Me.Id)
  For I = 2 To 15
    Range(nomtableau).Item(enreg, I) = Me("TextBox" & I)
  Next I
 
   raz
   UserForm_Initialize
End Sub

Private Sub B_sup_Click()
Dim Mdp As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
If Mdp <> "iknowvba" Then MsgBox "Accès refusé !": Exit Sub
 
  If MsgBox("Etes vous sûr de supprimer " & Me.enreg & "?", vbYesNo) = vbYes Then
     Range(nomtableau).Rows(Me.enreg).Delete
     Me.Recherche.List = Range(nomtableau).Value
  End If
End Sub
Private Sub B_ajout_Click()
  raz
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Me.enreg = Range(nomtableau).Rows.Count + 1
End Sub
'remise à zéro du formulaire
Sub raz()
  For I = 2 To 15
     Me("TextBox" & I) = ""
  Next I
 
End Sub
Private Sub B_suivant_Click()
 If Me.Recherche.ListIndex < Me.Recherche.ListCount - 1 Then
   Me.Recherche.ListIndex = Me.Recherche.ListIndex + 1
  End If
End Sub
Private Sub b_précédent_Click()
  If Me.Recherche.ListIndex > 0 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex - 1
  End If
End Sub
Private Sub bouton_quitter_Click()
Unload Me
' Reprotection de la feuille "Contrats" à éditer
Sheets("Contrats").Protect Password:="iknowvba"
End Sub
Sub Tri(a, gauc, droi, colTri) ' Quick sort
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For c = LBound(a, 2) To UBound(a, 2)
          temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi, colTri)
   If gauc < d Then Call Tri(a, gauc, d, colTri)
End Sub


Dérogation :
Code: 
Option Compare Text
Dim nomtableau

Private Sub Accord1_Change()

TextBox18.Visible = Accord1.ListIndex > 0
TextBox19.Visible = Accord1.ListIndex > 0
Label36.Visible = Accord1.ListIndex > 0
Label37.Visible = Accord1.ListIndex > 0

End Sub

'Initialisation du formulaire
Private Sub UserForm_Initialize()
nomtableau = "produit"
  Me.enreg = Range(nomtableau).Rows.Count + 1
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Tbl = Range(nomtableau).Value
  Me.Recherche.List = Tbl
 
   With Me
  .Diffusion.List = [Tableau2].Value
  .ListeMail.List = [Mail].Value
   End With
   For s = 1 To 4
   Me("Accord" & s).List = [Tableau3].Value
   Next
   ' déprotection de la feuille "Produits" à éditer
  Sheets("Commercialisation").Unprotect Password:="iknowvba"
End Sub

Private Sub Recherche_Change()
  Me.enreg = Application.Match(Val(Me.Recherche), Range(nomtableau).Columns(1), 0)
  Me.Id = Me.Recherche
  For i = 2 To 5
    Me("TextBox" & i) = Range(nomtableau).Item(enreg, i)
  Next i
        
  
    Me.TextBox46 = Range(nomtableau).Item(enreg, 6)
    Me.Textbox6 = Range(nomtableau).Item(enreg, 7)
    Me.Textbox7 = Range(nomtableau).Item(enreg, 8)
    Me.TextBox8 = Range(nomtableau).Item(enreg, 9)
    Me.TextBox9 = Range(nomtableau).Item(enreg, 10)
    Me.TextBox10 = Range(nomtableau).Item(enreg, 11)
    Me.TextBox11 = Range(nomtableau).Item(enreg, 12)
    Me.TextBox14 = Range(nomtableau).Item(enreg, 13)
    Me.TextBox15 = Range(nomtableau).Item(enreg, 14)
    Me.TextBox16 = Range(nomtableau).Item(enreg, 15)
    Me.TextBox17 = Range(nomtableau).Item(enreg, 17)
    Me.TextBox18 = Range(nomtableau).Item(enreg, 18)
    Me.TextBox19 = Range(nomtableau).Item(enreg, 20)
    Me.TextBox21 = Range(nomtableau).Item(enreg, 34)
    Me.TextBox34 = Range(nomtableau).Item(enreg, 21)
    Me.TextBox35 = Range(nomtableau).Item(enreg, 22)
    Me.TextBox36 = Range(nomtableau).Item(enreg, 23)
    Me.TextBox20 = Range(nomtableau).Item(enreg, 25)
    Me.TextBox37 = Range(nomtableau).Item(enreg, 26)
    Me.TextBox38 = Range(nomtableau).Item(enreg, 27)
    Me.TextBox39 = Range(nomtableau).Item(enreg, 28)
    Me.TextBox40 = Range(nomtableau).Item(enreg, 30)
    Me.TextBox41 = Range(nomtableau).Item(enreg, 31)
    Me.TextBox42 = Range(nomtableau).Item(enreg, 32)
    Me.TextBox43 = Range(nomtableau).Item(enreg, 35)
    Me.TextBox44 = Range(nomtableau).Item(enreg, 36)
    Me.TextBox45 = Range(nomtableau).Item(enreg, 37)
  '--- accords
    Me.Diffusion = Range(nomtableau).Item(enreg, 16)
    Me.Accord1 = Range(nomtableau).Item(enreg, 19)
    Me.Accord2 = Range(nomtableau).Item(enreg, 24)
    Me.Accord3 = Range(nomtableau).Item(enreg, 29)
    Me.Accord4 = Range(nomtableau).Item(enreg, 33)
End Sub

Private Sub B_valid_Click()
  enreg = Me.enreg
  Range(nomtableau).Item(enreg, 1) = Val(Me.Id)
  For i = 2 To 5
    Range(nomtableau).Item(enreg, i) = Me("TextBox" & i)
  Next i
    Range(nomtableau).Item(enreg, 6) = Me.TextBox46
    Range(nomtableau).Item(enreg, 7) = Me.Textbox6
    Range(nomtableau).Item(enreg, 8) = Me.Textbox7
    Range(nomtableau).Item(enreg, 9) = Me.TextBox8
    Range(nomtableau).Item(enreg, 10) = Me.TextBox9
    Range(nomtableau).Item(enreg, 11) = Me.TextBox10
    Range(nomtableau).Item(enreg, 12) = Me.TextBox11
    Range(nomtableau).Item(enreg, 13) = Me.TextBox14
    Range(nomtableau).Item(enreg, 14) = Me.TextBox15
    Range(nomtableau).Item(enreg, 15) = Me.TextBox16
    Range(nomtableau).Item(enreg, 17) = Me.TextBox17
    Range(nomtableau).Item(enreg, 18) = Me.TextBox18
    Range(nomtableau).Item(enreg, 20) = Me.TextBox19
    Range(nomtableau).Item(enreg, 34) = Me.TextBox21
    Range(nomtableau).Item(enreg, 21) = Me.TextBox34
    Range(nomtableau).Item(enreg, 22) = Me.TextBox35
    Range(nomtableau).Item(enreg, 23) = Me.TextBox36
    Range(nomtableau).Item(enreg, 25) = Me.TextBox20
    Range(nomtableau).Item(enreg, 26) = Me.TextBox37
    Range(nomtableau).Item(enreg, 27) = Me.TextBox38
    Range(nomtableau).Item(enreg, 28) = Me.TextBox39
    Range(nomtableau).Item(enreg, 30) = Me.TextBox40
    Range(nomtableau).Item(enreg, 31) = Me.TextBox41
    Range(nomtableau).Item(enreg, 32) = Me.TextBox42
    Range(nomtableau).Item(enreg, 35) = Me.TextBox43
    Range(nomtableau).Item(enreg, 36) = Me.TextBox44
    Range(nomtableau).Item(enreg, 37) = Me.TextBox45

  '-- accords
    Range(nomtableau).Item(enreg, 16) = Me.Diffusion
    Range(nomtableau).Item(enreg, 19) = Me.Accord1
    Range(nomtableau).Item(enreg, 24) = Me.Accord2
    Range(nomtableau).Item(enreg, 29) = Me.Accord3
    Range(nomtableau).Item(enreg, 33) = Me.Accord4
   raz
   UserForm_Initialize
End Sub
Private Sub ListeMail_Change()
Sheets("Mail").Cells(2, 7).Value = ListeMail.Text
End Sub

Private Sub EnvoiMail_Click()



  Dim ListeDest
  Dim i As Long
  Dim oMsgApp As Object
  Dim oMsg As Object
  Dim sListeDest As String
  Dim sFichier As String
 
 
  Set oMsgApp = CreateObject("Outlook.Application")
 
  ListeDest = Sheets("Mail").Cells(2, 7)
    
    Set oMsg = oMsgApp.CreateItem(0)
    With oMsg
      .To = ListeDest
      .Subject = "Formulaire de dérogation de " & Me.Textbox4.Text
      .Body = "Veuillez compléter le formulaire sous N:\SYSTEME DE MANAGEMENT DE LA QUALITE\SYSTEME DOCUMENTAIRE PURESSENTIEL\5 - REGISTRES et le transmettre au service suivant." & Chr(10) & Chr(13) & _
      Chr(10) & Chr(13) & "Bonne journée"
      .Send
    End With
    Set oMsg = Nothing
    
  Set oMsgApp = Nothing
  MsgBox "Mail envoyé"

End Sub '
Private Sub B_sup_Click()
Dim Mdp As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
If Mdp <> "iknowvba" Then MsgBox "Accès refusé !": Exit Sub
 
  If MsgBox("Etes vous sûr de supprimer " & Me.enreg & "?", vbYesNo) = vbYes Then
     Range(nomtableau).Rows(Me.enreg).Delete
     Me.Recherche.List = Range(nomtableau).Value
  End If
End Sub
Private Sub B_ajout_Click()
  raz
  Me.Id = Application.Max(Range(nomtableau).Columns(1)) + 1
  Me.enreg = Range(nomtableau).Rows.Count + 1
End Sub
'remise à zéro du formulaire
Sub raz()
  For i = 2 To 11
    Me("TextBox" & i) = ""
  Next i
    Me.TextBox14 = ""
    Me.TextBox15 = ""
    Me.TextBox17 = ""
    Me.TextBox18 = ""
    Me.TextBox19 = ""
    Me.TextBox34 = ""
    Me.TextBox35 = ""
    Me.TextBox36 = ""
    Me.TextBox20 = ""
    Me.TextBox21 = ""
    Me.TextBox37 = ""
    Me.TextBox38 = ""
    Me.TextBox39 = ""
    Me.TextBox40 = ""
    Me.TextBox41 = ""
    Me.TextBox42 = ""
    Me.TextBox43 = ""
    Me.TextBox44 = ""
    Me.TextBox45 = ""
    Me.TextBox46 = ""
 
    Me.Diffusion = ""
    For s = 1 To 4
     Me("Accord" & s) = ""

  Next s
 
End Sub
Private Sub B_suivant_Click()
 If Me.Recherche.ListIndex < Me.Recherche.ListCount - 1 Then
   Me.Recherche.ListIndex = Me.Recherche.ListIndex + 1
  End If
End Sub
Private Sub b_précédent_Click()
  If Me.Recherche.ListIndex > 0 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex - 1
  End If
End Sub
Private Sub bouton_quitter_Click()
Unload Me
' Reprotection de la feuille "Produits" à éditer
Sheets("Commercialisation").Protect Password:="iknowvba"
End Sub
Sub Tri(a, gauc, droi, colTri) ' Quick sort
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For c = LBound(a, 2) To UBound(a, 2)
          temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi, colTri)
   If gauc < d Then Call Tri(a, gauc, d, colTri)
End Sub
 

Pièces jointes

Trier par date Trier par votes
Déclarez une variable Private LOt As ListObject, initialisez la dans l'UserForm_Initialize, mettez vos valeurs des contrôles dans un tableau 2D d'une seule ligne nommé TVL() (Table des Valeurs de la Ligne courante) et utilisez les instructions :
TVL = LOt.ListRows(LCou).Range.Value
LOt.LIstRows(LCou).Range.Value = TVL
LOt.ListRows.Add.Range.Value = TVL
LOt.ListRows(LCou).Delete
Ou bien utilisez mes objets ComboBoxLiée et ControlsAssocié pour vous affranchir de la totalité des problème de recherche et de ventilation dans les différentes colonnes et obtenir directement votre LCou (n° de Ligne Courante). Le ComboBoxLiées est munie d'une propriété Lignes de type ListRows, reprenant celle du ListObject détecté.
 
Dernière édition:
Vote positif 0 Vote négatif
Vous voulez la définition de ces deux objets avec une feuille d'aide expliquant toutes leurs propriété, méthodes et évènements, oui ou non ?
Le reste c'est du chinois ?
TVL = LOt.ListRows(LCou).Range.Value ' Envoi dans le tableau VBA dynamique TVL les valeurs de la plage couverte par la LCouième ligne du tableau Excel représenté par le ListObject LOt
LOt.LIstRows(LCou).Range.Value = TVL ' Affecte aux valeurs de la plage couverte par la LCouième ligne du tableau Excel celles contenues dans ce tableau VBA
LOt.ListRows.Add.Range.Value = TVL ' Crée une nouvelle ligne et y range les valeurs contenues dans TVL
LOt.ListRows(LCou).Delete ' Supprime la LCouième ligne du LOt
C'est couillon, je n'aurais peut être pas du inventer ce mot LCouième 😉
Remarque: Les objets ComboBoxLiées et ControlsAssociés sont munis de méthodes ValeurDepuis et ValeursVers qui vous dispensent de vous occuper des détails, sauf dans la UserForm Initialize, où vous devez déclarer à quoi correspond tout ce qu'il y a à gérer.
 
Dernière édition:
Vote positif 0 Vote négatif
C'est un ordinateur professionnel je n'ai le droit de rien télécharger dessus malheureusement. Il faudrait que ma demande passe par le service informatique qui ne répond jamais à mes demandes justement. Merci beaucoup de votre aide je regarderai chez moi ou les laisserai se débrouiller
 
Vote positif 0 Vote négatif
Si le contexte d'utilisation, distribution etc. est trop compliqué, il serait possible d'équiper le classeur d'application de tous les modules de service nécessaires. Ça en fait un bon paquet quand même … Et la feuille d'aide n'y sera plus.
 
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

Amigo
  • Question Question
XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier
2 3
Réponses
33
Affichages
1 K
Amigo
Amigo
Dadi147
  • Résolu(e)
XL 2019 Le problème de la suppression des virgules lors de la modification des valeurs Listbox
Réponses
5
Affichages
804
Dadi147
Dadi147
M
  • Question Question
Autres remplir auto. l'objet de l'email avec nom PJ dans Outlook (et si pas de pj alors aucun objet)
2
Réponses
29
Affichages
801
TooFatBoy
TooFatBoy
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
661
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
495
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
564
un internaute
U
J
  • Question Question
XL 2021 transfert listview vers feuille excel
Réponses
9
Affichages
601
Piment
P
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
238
nabilexcel2007
N
patricktoulon
  • Question Question
Microsoft 365 datepicker dynamique intra userform ou dans feuille 2 versions(frame dynamique)(toute version d'excel )
6 7 8
Réponses
105
Affichages
3 K
Usine à gaz
Usine à gaz
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
768
escudo
E
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
643
thunder23
thunder23
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
692
Claudinedu13
C
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
939
tnion
T
Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
603
Lu76Fer
Lu76Fer
anthoYS
  • Résolu(e)
Microsoft 365 VBA : Commentaire en B, C, D après clic droit dans n'importe quelle cellule de cette plage ?
2
Réponses
15
Affichages
597
Nicolas JACQUIN
Nicolas JACQUIN
Regueiro
  • Question Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
567
fanch55
fanch55
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
3 K
francescofrancesco
F
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
643
sylvanu
sylvanu
C
  • Résolu(e)
XL 2021 VBA : Afficher plusieurs résultats d'une boucle dans une cellule
Réponses
3
Affichages
322
Claudinedu13
C
Retour