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

Sparfell29 · 9 Juillet 2019

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

Dranreb · 9 Juillet 2019

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é.

Sparfell29 · 9 Juillet 2019

Je n'ai absolument pas compris la réponse c'est trop technique pour le peu de connaissance que j'ai.
J'ai compris jusqu'à "initialisez la dans l'UserForm_Initialize " le reste c'est du chinois pour moi :/

Dranreb · 9 Juillet 2019

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.

Sparfell29 · 9 Juillet 2019

Ça serait très gentil de votre part si cela ne vous prend pas trop de temps

Dranreb · 9 Juillet 2019

Voici le classeur précurseur d'un .xlam qui demande automatiquement la permission de s'installer quand on l'ouvre.
Il contient les définitions des deux objets mentionnés.

Sparfell29 · 9 Juillet 2019

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

Dranreb · 9 Juillet 2019

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.

Sparfell29 · 9 Juillet 2019

Je regarderai tout ça au calme à la maison merci beaucoup de votre aide en tout cas =)

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

Sparfell29

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

Sparfell29

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Sparfell29

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Pièces jointes

Sparfell29

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Sparfell29

XLDnaute Nouveau

Discussions similaires