UserForm_Initialize d'une autre feuille

Bonsoir à tous,

J'ai essayer de trouver une solution à mon problème et jai trouver un code qui me convient presque sauf que je narrive pas à le résoudre et pourtant j'ai essayer pleins de chose mais je comprend pas ce code la, c'est utiliser un UserForm_Initialize() mais je narrive pas a le lancer d'une autre feuille.

Voici mon code:

Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  bd = f.Range("a2:h" & [a65000].End(xlUp).Row).Value
  For i = 1 To UBound(bd, 2)
    temp = temp & f.Columns(i).Width * 1.1 & ";"
    Me("label" & i) = f.Cells(1, i)
    Me("label" & i + 100) = f.Cells(1, i)
    Me("label" & i).Top = Me.ListBox1.Top - 12
    largeur = largeur + f.Columns(i).Width * 1.1
   Next
   Me.ListBox1.ColumnCount = UBound(bd, 2)
   Me.ListBox1.ColumnWidths = temp
   Me.Width = largeur + 50
   Me.ListBox1.List = bd
   Set d1 = CreateObject("scripting.dictionary")
   For i = 1 To UBound(bd)
     If bd(i, 1) <> "" Then d1(bd(i, 1)) = ""
   Next i
   a = d1.keys
   If d1.Count > 0 Then Call tri(a, LBound(a), UBound(a))
   Me.ComboBox1.List = a
   Me.ComboBox1.SetFocus
End Sub
Private Sub ComboBox1_Change()
     Set d1 = CreateObject("scripting.dictionary")
     clé = UCase(Me.ComboBox1) & "*"
     Dim Tbl()
     n = 0: ncol = UBound(bd, 2)
     For i = LBound(bd) To UBound(bd)
       If UCase(bd(i, 1)) Like clé Then
         n = n + 1: ReDim Preserve Tbl(1 To ncol, 1 To n)
         For k = 1 To ncol: Tbl(k, n) = bd(i, k): Next
         If bd(i, 1) <> "" Then d1(bd(i, 1)) = ""
       End If
      Next i
      If n > 0 Then
        ReDim Preserve Tbl(1 To ncol, 1 To n + 1)
        Me.ListBox1.List = Application.Transpose(Tbl)
        Me.ListBox1.RemoveItem n
      End If
      a = d1.keys
      If d1.Count > 0 Then Call tri(a, LBound(a), UBound(a))
      Me.ComboBox1.List = a
      Me.ComboBox1.DropDown
End Sub
Private Sub ListBox1_Click()
  lig = Me.ListBox1.ListIndex
  For i = 1 To 8
    Me("textbox" & i) = Me.ListBox1.List(lig, i - 1)
  Next i
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bd)
    If bd(i, 1) <> "" Then d1(bd(i, 1)) = ""
  Next i
  a = d1.keys
  If d1.Count > 1 Then Call tri(a, LBound(a), UBound(a))
  Me.ComboBox1.List = a
  Me.ComboBox1.DropDown
End Sub

Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = 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

Merci pour vos réponses

Bonsoir Edward,

un formulaire UserForm a son propre code VBA, et s'il s'y trouve une sub UserForm_Initialize() (car c'est facultatif, donc pas obligé), alors cette sub est exécutée automatiquement à l'ouverture du formulaire ; la sub UserForm_Initialize() du formulaire UserForm1 ne s'exécutera pas à l'ouverture d'un autre formulaire !

pour le reste, je laisse à un autre intervenant le soin de te répondre.

dhany

Bonjour,

En guise de préliminaire :

1 - Dans ce forum, quand on cite du code on utilise la balise </> : C'est bien pratique et on évite un long pensum inutile et illisible.

2 - Ce type de code que je ne renie pas est extrêmement difficile à manipuler pour un débutant car incompréhensible : les trop nombreuses variables non dimensionnées et avec une seule lettre rendent l'ensemble peu facile à adapter pour le profane.

Il reste que Boisgontier est une référence qui force le respect...

J'ai donc du remanier un peu l'ensemble... pour lui donner un peu de lisibilité.

Au nombre des modifications qui pourraient t'échapper et sur lesquelles tu as le droit de demander des précisions :

Le CodeName de la feuille "BD" est maintenant WsBD (On modifie cette propriété dans la fenêtre des propriétés de VBAProject)

J'ai renommé le UserForm usfBD

J'ai également renommé le combo (cboRech) et précisées quelques variables...

L'ensemble fonctionne bien cependant vis à vis de la question initiale et reste assez proche de l'idée de départ ... Cependant je doute un peu de la faisabilité d'adapter TOUSSA aux nécessités d'un usf "intégral" de type CRUD : C'est à dire capable de faire non seulement la recherche mais également les ajouts, modifications et suppressions qui sont le but généralement attendu de ce genre de Userform.

Mébon c'est déjà un point de départ...

A+

Bonsoir dhany,

Merci pour l'info mais je voulais l'ouvrir juste à partir d'une autre feuille et pas l'ouvrir d'un autre formulaire mais merci quand même

Et bonsoir galopin01,

Merci pour la correction j'essaye ça demain. Désolé pour les balises je connais pas trop comment marche les forums .

Oui j'ai vu que cela était très compliqué a manipuler mais très intéressant je vais l'apprendre ça c'est sur

Je reviens vous faire un retour dès que j'ai pu le tester.

Merci encore à vous pour tout.

Bonjour,

cf PJ

Boisgontier

Autre version

Option Compare Text
Dim f, Rng, TblBD(), NbCol, ColRech
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set d = CreateObject("Scripting.Dictionary")
  Set Rng = f.Range("A2:H" & f.[A65000].End(xlUp).Row)
  NbCol = Rng.Columns.Count
  ColRech = 1
  TblBD = Rng.Value
  Me.ListBox1.List = TblBD
  d("*") = ""
  For i = LBound(TblBD) To UBound(TblBD)
     d(TblBD(i, ColRech)) = ""
  Next i
  clé = d.keys
  Tri clé, LBound(clé), UBound(clé)
  Me.ComboBox1.List = clé
  Me.ListBox1.ColumnCount = Rng.Columns.Count
  EnteteListBox
  LabelTitre
End Sub

Private Sub ComboBox1_click()
  profession = Me.ComboBox1: n = 0
  Dim Tbl()
  For i = 1 To UBound(TblBD)
     If TblBD(i, ColRech) Like profession Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
     End If
   Next i
   Me.ListBox1.Column = Tbl
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To Me.ListBox1.ColumnCount
    Set lab = Me.Controls.Add("Forms.Label.1")
    lab.Caption = Rng.Offset(-1).Cells(1, i)
    lab.Top = Y
    lab.Left = x
    x = x + Rng.Columns(i).Width * 1.1
    temp = temp & Rng.Columns(i).Width * 1.1 & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
End Sub

Sub LabelTitre()
  TblTitre = Application.Transpose(Rng.Offset(-1).Resize(1))
  For i = 1 To NbCol
     Me("label" & i) = TblTitre(i, 1)
     Me("textbox" & i).Width = Rng.Columns(i).Width * 1.1
  Next i
End Sub

Private Sub ListBox1_Click()
  lig = Me.ListBox1.ListIndex
  For i = 1 To NbCol
    Me("textbox" & i) = Me.ListBox1.List(lig, i - 1)
  Next i
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = 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

Boisgontier

BOnjour

Donc je viens d'essayer et c'est juste au top.

Merci encore pour tout c'est génial

Bon en faites c'est geniale du moment que l'on ne rajoute pas de personne.

Comment faire pour pouvoir rajouter des lignes et que ça marche encore?

Bonjour,

Avec Ajout, Sup, Modif

Boisgontier

Bonjour,

Malgré toute l'estime que j'ai pour jb. Moi personnellement j'aurai plutôt tendance à conseiller un truc comme en pièce jointe : C'est comme les antibiotiques : pas automatique mais suffisamment modulaire pour que n'importe qui un peu doué soit capable de fignoler selon les besoins. Bon je le dis en toute modestie vu que le truc est pas de moi, je le trouve plus adapté au grand débutant que je suis...

Bonne lecture.

A+