Erreur execution 35787

Bonjour le forum,

Sur mon formulaire après avoir sélectionner différents groupe dans la ComboBox, la listbox crée des lignes vides.

Et j"ai le message suivant :

ensuite comment incrémenter un logo à la ligne correspondante du client sélectionné

Cordialement

Salut Le_Troll_Du_27

De mieux en mieux ta petite appli

Il faudrait nous dire comment faire pour obtenir ton souci

A+

Bonjour le forum, le fil, BrunoM45

Au lancement du formulaire, la listbox est renseignée.

On sélectionne la ComboBox "CmbB_Recherche_Groupe" , et nous sélectionnons par exemple "Fournisseur".

Le filtre s'applique et la listbox est mal renseignée. On y découvre des lignes vides alors qu'il ne devrait pas y avoir.

Si on clique sur la ligne vide:

DTPicker bug car la date ne peut pas être nul.

Alors comment peut on faire pour avoir tout simplement unr listbox bien renseignée qu'elle en soit le filtre imposé par la ComboBox.?

Et ensuite j'ai rajouté une ligne en A de la feuille "Clients" et une autre feuille "Images". Je voudrais pouvoir inserer un logo client ou une photo pour chaque clients.

Voilà j'espère que j'ai été précis

Cordialement

Bonsoir Laurent

Tu as été très explicite, je vais essayé de l'être également

Quand tu regardes le déroulement du code, la recherche de la dernière ligne du tableau ne se fait pas bien

La dernière ligne trouvée est 23 au lieu de 20

Il faut donc corriger le code de filtrage, par

Sub FiltrerContacts(nCol As Long, sCrit As String)
  Dim Colonne As Long, DLig As Long, LaLigne As Long, Ligne As Long
  Userform1.LstB_Referentiel.Clear
  LaLigne = LaLigne + 1
  ReDim Plage(1 To 67, 1 To LaLigne)        ' les colonnes de la plage en ligne dans le tableau
  ' Filtrer les lignes
  With Sheets("Clients")
    ' Dernière ligne
    'DLig = .Range("A" & Rows.Count).End(xlUp).Row
    DLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Vérifier qu'il y a bien une valeur sur la dernière ligne, sinon déduire 1
    If .Range("A" & DLig).Value = "" Then DLig = DLig - 1
    ' Si aucun filtre, l'activer
    If .AutoFilter Is Nothing Then .Range("A1:B01").AutoFilter
    ' Si la colonne est supérieure à 1 on utilise LIKE *valeur*
    If nCol > 1 Then sCrit = "*" & sCrit & "*"
    .Range("A1:B0" & DLig).AutoFilter Field:=nCol, Criteria1:=sCrit
    ' Parcourir les lignes visible
    For Ligne = 2 To DLig
      ' Vérifier que la ligne n'est pas masqué par le filtre
      If Rows(Ligne).EntireRow.Hidden = False Then
        For Colonne = 1 To 67
          Plage(Colonne, LaLigne) = .Cells(Ligne, Colonne)
          Plage(13, LaLigne) = Ligne
        Next Colonne
        ' Vérifier que la ligne n'est pas vide, sinon = fin tableau, on sort
        If Application.CountA(Sheets("Clients").Rows(Ligne + 1 & ":" & Ligne + 1)) = 0 Then Exit For
        ' Sinon on passe à la ligne suivante
        LaLigne = LaLigne + 1
        ReDim Preserve Plage(1 To 67, 1 To LaLigne)
      End If
    Next Ligne
    Userform1.LstB_Referentiel.List = Application.Transpose(Plage)
  End With
End Sub

Ensuite je me suis aperçu d'un gros soucis à l'initialisation de ton Userform1

Avec ce code

For i = 1 To Sheets("Clients").Range("A65536").End(xlUp).Row
    If Sheets("Clients").FilterMode Then Sheets("Clients").ShowAllData
    CmbB_Recherche_Groupe = Sheets("Clients").Range("B" & i)
    If CmbB_Recherche_Groupe.ListIndex = -1 Then CmbB_Recherche_Groupe.AddItem Sheets("Clients").Range("B" & i)
  Next i

Si un groupe n'existe pas, tu veux l'ajouter à ta Combobox, soucis, avec cette procédure tu filtres et supprime le filtre sur chaque ligne et tu n'en a que 20

Ce qu'il faut faire, c'est chercher ton groupe dans la feuille données avec au pire une fonction Excel, comme ceci

  With Sheets("Clients")
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
      If Application.CountIf(Sheets("Données").Range("A:A"), .Range("B" & i)) = 0 Then
        CmbB_Recherche_Groupe.AddItem Sheets("Clients").Range("B" & i)
      End If
    Next i
  End With

Nota : oublie le chiffre 65535, c'était bon pour 2003 et antérieur

A+

bonjour le forum, le fil , BrunoM45

Je te remercie Bruno.

La correction du filtre est impec. J'ai insisté avec le filtre et aucune erreur.

Ensuite j'ai tellement tituré dans tous les sens que j'en avais totalement oculté ces 4 lignes.

Et merci j'essaye le plus souvent de me séparer du 65536

Cordialement

Re,

Attention, j'ai trouvé un problème si tu choisi un groupe pour lequel il n'y a qu'une ligne (exemple particulier)

J'ai" bidouillé" le code du filtrage de la sorte

Sub FiltrerContacts(nCol As Long, sCrit As String)
  Dim Colonne As Long, DLig As Long, LaLigne As Long, Ligne As Long
  Userform1.LstB_Referentiel.Clear
  ' Dimensionner le tableau
  LaLigne = 1: ReDim Plage(1 To 67, 1 To LaLigne)
  ' Filtrer les lignes
  With Sheets("Clients")
    ' Dernière ligne
    'DLig = .Range("A" & Rows.Count).End(xlUp).Row
    DLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Vérifier qu'il y a bien une valeur sur la dernière ligne, sinon déduire 1
    If .Range("A" & DLig).Value = "" Then DLig = DLig - 1
    ' Si aucun filtre, l'activer
    If .AutoFilter Is Nothing Then .Range("A1:B01").AutoFilter
    ' Si la colonne est supérieure à 1 on utilise LIKE *valeur*
    If nCol > 1 Then sCrit = "*" & sCrit & "*"
    .Range("A1:B0" & DLig).AutoFilter Field:=nCol, Criteria1:=sCrit
    ' Parcourir les lignes visible
    For Ligne = 2 To DLig
      ' Vérifier que la ligne n'est pas vide, sinon = fin tableau, on sort
      If Application.CountA(Sheets("Clients").Rows(Ligne & ":" & Ligne)) = 0 Then Exit For
      ' Vérifier que la ligne n'est pas masqué par le filtre
      If Rows(Ligne).EntireRow.Hidden = False Then
        ' Redimensionner le tableau à partir de la 2ème ligne
        If LaLigne > 1 Then ReDim Preserve Plage(1 To 67, 1 To LaLigne)
        ' Pour chaque colonne
        For Colonne = 1 To 67
          Plage(Colonne, LaLigne) = .Cells(Ligne, Colonne)
          Plage(13, LaLigne) = Ligne
        Next Colonne
        ' Incrémenter la ligne du tableau
        LaLigne = LaLigne + 1
      End If
    Next Ligne
    ' ATTENTION problème avec transpose si une seule ligne
    If LaLigne = 2 Then
      ReDim Preserve Plage(1 To 67, 1 To LaLigne)
      Userform1.LstB_Referentiel.List = Application.Transpose(Plage)
      Userform1.LstB_Referentiel.RemoveItem (LaLigne - 1)
    Else
      Userform1.LstB_Referentiel.List = Application.Transpose(Plage)
    End If
  End With
End Sub

Il y a certainement plus propre

A+

Bonjour le forum, le fil, BrunoM45

Je te remercie pour avoir corrigé USF

Maintenant je vais

Je vais ouvrir une autre discutions pour attribuer un logo à un client

Cordialement

Laurent