USF affichage et Tri en vba

  • Initiateur de la discussion Initiateur de la discussion Byfranck
  • Date de début Date de début

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 !

Byfranck

XLDnaute Occasionnel
Bonjour à tous,
tout dabord merci de l'aide apportée: J'avance pas si mal sur ma base de données. 😀
Maintenant je touche mes limites .. qui sont pas très hautes je sais... rolleyes:
Reste donc quelques questions sur des points importants et sur lesquels je coince:
Pour faire simple je vais rester avec le fichier d'origine.
BD Fournisseurs V12 (dans la zone de téléchargements):
Excel Downloads - Gestion commerciale

Dans UserForm1 :
Bouton Recherche rapide (liste alphabétique)=> ouvre l'UserForm5
Dans l'UserForm5 il y a une liste déroulante avec les noms de "Société"
Question: Je n'arrive pas à faire afficher une deuxième colonne à côté de celle-ci (je voudrais voir à chaque ligne société le code postal correspondant qui se trouve en colonne H)
Y a-t-il une autre solution que CONCATENER les données qui m'interessent dans la colonne A

Dans UserForm1 : le deuxième bouton permet de faire une recherche sur un mot clef.
Y a t'il une sulotion pour que ce mot clef soit recherché dans une colonne particulière? par exemple:
choisir parmis les intitulés de colonnes et ne faire afficher que (ou ouvrir les fiches) de ceux qui correspondent à ce critère:
Exemple sur les critères de la colonne B (dont l'intitulé est cca/ppa dans la feuille1) n'afficher que les fiches de sociétés = Oui

Merci d'avance pour votre aide
 
Re : USF affichage et Tri en vba

Bonjour,

Une solution pour votre demande N°1
Dans UserForm1 :
Bouton Recherche rapide (liste alphabétique)=> ouvre l'UserForm5
Dans l'UserForm5 il y a une liste déroulante avec les noms de "Société"
Question: Je n'arrive pas à faire afficher une deuxième colonne à côté de celle-ci (je voudrais voir à chaque ligne société le code postal correspondant qui se trouve en colonne H)

Remplacez, dans le module6, la Sub test par le code suivant
Code:
Sub test()
    
     'ordre alphabetique
    Sheets("feuil1").Range("A8").Select
    selection.Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
      Call calculnombrefiches
       
          'redéfini selection
'    Sheets("feuil1").Range("A8").Resize(rowsize:=Range("F1").Value, columnsize:=1).Select
'        UserForm5.ListBox1.List = selection.Value
        
Dim var
Dim T()
Dim i&
var = Sheets("feuil1").Range("A8:h" & Sheets("feuil1").Range("F1").Value + 7 & "")
ReDim T(1 To UBound(var, 1), 1 To 2)
For i& = 1 To UBound(var, 1)
  T(i&, 1) = var(i&, 1)
  T(i&, 2) = var(i&, 8)
Next i&
With UserForm5.ListBox1
  .ColumnCount = 2
  .ColumnWidths = "" & .Width / 3 * 2 & ";" & .Width / 3 & ""
  .List = T
End With

    UserForm5.Show

End Sub

Cordialement.

PMO
Patrick Morange
 
Re : USF affichage et Tri en vba

Bonsoir PMO2 ..

Snif j'était tout content...
J'ai une :
Erreur d'éxecution '9'
L'indice n'apartient pas àla sélection

le débogueur s'arrête sur: T(i&, 2) = var(i&, 8)

pour info j'ai modifié la sub Test pour qu'elle classse selon les num de département (chez moi c'est la colonne J8) j'ai donc:

Sub test()

'ordre alphabetique
Sheets("feuil1").Range("J8").Select
selection.Sort Key1:=Range("J8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Call calculnombrefiches

'redéfini selection
Sheets("feuil1").Range("A8").Resize(rowsize:=Range("F1").Value, columnsize:=1).Select
UserForm5.ListBox1.List = selection.Value

UserForm5.Show

End Sub


Voila voila tu sais tout !
 
Re : USF affichage et Tri en vba

bonjour,

ça y est j'ai trouvé comment ça marche ... SUPER !!!

ça plantait parceque j'avais des lignes vides!
Maintenant j'ai bien la société et le département à côté 🙂

Merci M'sieur

Du coup j'ai d'autres questions:
A) Est-il possible de pouvoir redimenssioner avec la souris les colonnes qui s'affichent.

B) Dans cette SUB Test, y a t'il moyen de faire automatiquement le classement suivant pour qu'il aparaisse ainsi dans l'UserForm5 :
Classement par département.
et que pour chaque département la liste de sociétés soit classée par ordre alphabétique?

Merci d'avance pour votre aide
franck
 
Re : USF affichage et Tri en vba

Bonjour,

A la question

Est-il possible de pouvoir redimensionner avec la souris les colonnes qui s'affichent dans une ListBox ?

voici un exemple pour y répondre.

1) Créez un UserForm1 et y ajouter un Label1 et une ListBox1
2) Dans la fenêtre de code du UserForm copiez le code suivant
Code:
Dim SourceX!
Dim T()

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i&
Dim colLarg!
Dim A$
Dim pos&
If Button = 2 And Shift = 1 Then
  With ListBox1
    If Y < .Font.Size Then
      SourceX! = X
      ReDim T(1 To .ColumnCount)
      A$ = .ColumnWidths & ";"
      For i& = 1 To UBound(T)
        pos& = InStr(1, A$, ";")
        T(i&) = CSng(Val(Mid(A$, 1, pos& - 1)))
        A$ = Mid(A$, pos& + 1)
      Next i&
      For i& = 1 To UBound(T)
        colLarg! = colLarg! + T(i&)
      Next i&
      If X > colLarg! Then
        SourceX! = 0
        Erase T
      End If
    End If
  End With
End If
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i&
Dim deb!
Dim fin!
Dim A$
If SourceX! > 0 Then
  For i& = 1 To UBound(T)
    fin! = fin! + T(i&)
    If X > SourceX! Then
      If SourceX > deb! And SourceX < fin! Then
        T(i&) = T(i&) + X - fin!
        Exit For
      End If
    ElseIf X < SourceX! Then
      If X > deb! And X < fin! Then
        T(i&) = X - deb!
        Exit For
      End If
    End If
    deb! = fin!
  Next i&
  For i& = 1 To UBound(T)
    If T(i&) < 15 Then T(i&) = 15
    A$ = A$ & T(i&) & ";"
  Next i&
  If A$ <> "" Then ListBox1.ColumnWidths = "" & Mid(A$, 1, Len(A$) - 1) & ""
  SourceX! = 0
  Erase T
End If
End Sub

Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim var
Dim nbCol&
Dim i&
Dim A$
On Error Resume Next
Set S = Sheets(MA_FEUILLE)
If Err <> 0 Then
  MsgBox "La feuille ''" & MA_FEUILLE & "'' est introuvable."
  Unload Me
  Exit Sub
End If
On Error GoTo 0
With Me
  .Caption = "Modifier la largeur des colonnes d'une ListBox"
  .Width = 400
  .Height = 220
End With
With ListBox1
  .Top = 50
  .Left = 20
  .Width = Me.Width - 40
  .Height = Me.Height - 100
End With
With Label1
  .Top = 10
  .Left = 30
  .Caption = "Pour modifier la largeur des colonnes, maintenez Shift et clic droit" & _
      " puis bougez latéralement la souris dans la ligne de titre de la ListBox"
  .AutoSize = True
  .AutoSize = False
  .Width = Me.Width - 60
End With
Set R = Sheets(MA_FEUILLE).UsedRange
var = R
nbCol& = UBound(var, 2)
With ListBox1
  .ColumnCount = UBound(var, 2)
  .ColumnHeads = True
  .List = var
  '--- Fabrique une chaîne des largeurs du type "50;50;50..." ---
  For i& = 1 To nbCol&
    A$ = A$ & "50;"
  Next i&
  A$ = "" & Mid(A$, 1, Len(A$) - 1) & ""
  .ColumnWidths = A$
End With
End Sub

3) Dans un module Standard copiez le code suivant
Code:
'### Nom de la feuille des data (à adapter) ###
Public Const MA_FEUILLE As String = "test"
'##############################################
 
Sub Lancer()
On Error Resume Next
UserForm1.Show (vbModeless)
End Sub

4) Dans Excel, créez une feuille nommée "test" et inscrivez-y des données, à partir de A1, sur plusieurs lignes et plusieurs colonnes.

Il n'y a plus qu'à lancer la macro judicieusement nommée "Lancer" pour faire apparaître le UserForm.
Pour modifier la largeur des colonnes de la ListBox, placez le curseur de la souris dans sa ligne d'en-têtes, appuyez sur la touche majuscule MAINTENUE et faites clic droit puis déplacez latéralement la souris jusqu'à excéder la limite, droite ou gauche, de la colonne dans laquelle vous vous trouvez.

Cordialement.

PMO
Patrick Morange
 
- 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

Réponses
4
Affichages
245
Réponses
4
Affichages
432
Retour