Macro + formulaire de gestion documentaire, pb de remontée d

Bonsoir

Néophyte en vba, je cherche en m inspirant de codes généreusement mis à disposition sur le net à élaborer un outil de gestion de documents basé sur un formulaire.

Je voudrai pouvoir créer une ligne par document, pouvoir modifier les valeurs et supprimer certaines lignes également.

Le code que j ai trouvé (merci j Boisgontier) permet notamment de sélectionner via un formulaire une référence parmis les documents déjà enregistrés et les informations de description relatives au doc choisi remontent automatiquement dans le formulaire, ce qui constitue le graal pour moi.

Le code originel fonctionne très bien, j ai donc essayé de l adapter à mon cas.

Malheureusement lorsque je saisis une référence, les éléments de description du document n apparaissent pas dans le formulaire comme je le souhaiterai.

Voici le code. Voyez vous une erreur ? Des suggestions ou conseil ?

Merci d avance pour votre aide

Thierry

Dim f, ligneEnreg
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Clé = f.Range("B2:B" & f.[B65000].End(xlUp).Row)
   ' MsgBox UBound(Clé)
   ' MsgBox LBound(Clé)
   Me.BU.List = Array("TCI")
   Me.FA.List = Array("NEM", "PRM")
   Me.DT.List = Array("DIR", "POL")
   Me.LA.List = Array("EN", "DE")
   Me.PO.List = Array("TO REVIEW", "TO CREATE")
  '-------------avec tri---------------

   Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.CR.List = Clé
  Me.CR.ListIndex = 0
  ' MsgBox CR
  ' MsgBox Sheets("BD").[B:B].Find(CR, LookIn:=xlValues).Row

End Sub

Private Sub ChoixNom_Click()
   ligneEnreg = Sheets("BD").[B:B].Find(CR, LookIn:=xlValues).Row
   ' MsgBox CR
   ' MsgBox ligneEnreg

   Me.DR = f.Cells(ligneEnreg, 2) ' cle
   Me.RE = f.Cells(ligneEnreg, 1)
   Me.TI = f.Cells(ligneEnreg, 3)
   Me.BU = f.Cells(ligneEnreg, 4)
   Me.FA = f.Cells(ligneEnreg, 5)
   Me.DT = f.Cells(ligneEnreg, 6)
   Me.DN = f.Cells(ligneEnreg, 7)
   Me.LA = f.Cells(ligneEnreg, 8)
   Me.AR = f.Cells(ligneEnreg, 9)
   Me.AU = f.Cells(ligneEnreg, 10)
   Me.CH = f.Cells(ligneEnreg, 11)
   Me.AP = f.Cells(ligneEnreg, 12)
   Me.DL = f.Cells(ligneEnreg, 13)
' 14
   Me.CO = f.Cells(ligneEnreg, 15)
' 16
   ' validity
   For Each c In Me.VA.Controls
     If f.Cells(ligneEnreg, "a") = c.Caption Then c.Value = True
   Next c

   'progress
   temp = f.Cells(ligneEnreg, 16)
   a = Split(temp, ";")
   For j = 0 To Me.PO.ListCount - 1: Me.PO.Selected(j) = False: Next j
   If UBound(a) >= 0 Then
        For j = 0 To Me.PO.ListCount - 1
           If Not IsError(Application.Match(Me.PO.List(j), a, 0)) Then
               Me.PO.Selected(j) = True
           Else
               Me.PO.Selected(j) = False
           End If
         Next j
    End If
End Sub
Private Sub B_validation_Click()
  'If Me.DR = "" Then
   '  MsgBox "Saisir un nom"
    ' Me.DR.SetFocus
     'Exit Sub
  'End If
' If Not IsDate(Me.RE) Then
  '   MsgBox "Saisir une date"
   '  Me.RE.SetFocus
    ' Exit Sub
  'End If

  'If Not IsDate(Me.RE) Then
   '  MsgBox "Saisir une date"
    ' Me.RE.SetFocus
     'Exit Sub
  'End If
' If Not IsNumeric(Me.Salaire) Then
  '   MsgBox "Saisir un salaire"
   '  Me.Salaire.SetFocus
    ' Exit Sub
  ' End If
  '--- Transfert Formulaire dans BD

   f.Cells(ligneEnreg, 2) = Me.BU & "_" & Me.FA & "_" & Me.DT & "_" & Me.DN & "_" & Me.LA & "_" & Me.AR       ' Application.Proper(Me!nom)

   f.Cells(ligneEnreg, 1) = Me.RE
   f.Cells(ligneEnreg, 3) = Me.TI
   f.Cells(ligneEnreg, 4) = Me.BU
   f.Cells(ligneEnreg, 5) = Me.FA
   f.Cells(ligneEnreg, 6) = Me.DT
   f.Cells(ligneEnreg, 7) = Me.DN
   f.Cells(ligneEnreg, 8) = Me.LA
   f.Cells(ligneEnreg, 9) = Me.AR
   f.Cells(ligneEnreg, 10) = Me.AU
   f.Cells(ligneEnreg, 11) = Me.CH
   f.Cells(ligneEnreg, 12) = Me.AP
   f.Cells(ligneEnreg, 13) = Date
   f.Cells(ligneEnreg, 15) = Me.CO

   '-- validity
   temp = ""
   For Each c In Me.VA.Controls
    If c.Value = True Then
     temp = c.Caption
     End If
   Next c
   f.Cells(ligneEnreg, 14) = temp

   '-- progress
   temp = ""
   For i = 0 To Me.PO.ListCount - 1
      If Me.PO.Selected(i) = True Then temp = temp & Me.PO.List(i) & ";"
   Next i
   f.Cells(ligneEnreg, 16) = temp
End Sub

Private Sub B_ajout_Click()
  ligneEnreg = f.[A65000].End(xlUp).Row + 1
  Me.DR = ""
  Me.RE = ""
  Me.TI = ""
  Me.BU = ""
  Me.FA = ""
Me.DT = ""
  Me.DN = ""
  Me.LA = ""
  Me.AR = ""
Me.AU = ""
  Me.CH = ""
  Me.AP = ""
  Me.DL = ""
  Me.CO = ""

  For j = 0 To Me.PO.ListCount - 1: Me.PO.Selected(j) = False: Next j
  Me.DR.SetFocus
End Sub

Private Sub B_suivant_Click()
If Me.CR.ListIndex < Me.CR.ListCount - 1 Then
   Me.CR.ListIndex = Me.CR.ListIndex + 1
  End If
End Sub

Private Sub b_précédent_Click()
  If Me.CR.ListIndex > 0 Then
    Me.CR.ListIndex = Me.CR.ListIndex - 1
  End If
End Sub

Private Sub b_fin_Click()
  Unload Me
End Sub

sub Tri(a, gauc, droi) ' Quick sort
   ref = a((gauc + droi) \ 2, 1)
   g = gauc: d = droi
   Do
     Do While a(g, 1) < ref: g = g + 1: Loop
     Do While ref < a(d, 1): d = d - 1: Loop
     If g <= d Then
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Bonjour Thierry.31 et

Commence par mettre ton code entre les balises [code] et [/ code] sans espace après le / :wink:

A+