Selectionner l'adresse de plusieurs colonnes séparées

Sa Mariam

XLDnaute Nouveau
Bonjour, je souhaite afficher sous format de tableau plusieurs colonnes qui ne se trouve pas l'une à coté de l'autre, pour cela jai réalisé le code suivant:
VB:
Private Sub UserForm_Initialize()
Sheets("Liste des pièces").Select
ListBox2.ColumnCount = 7
ListBox2.ColumnHeads = True
ListBox2.ColumnWidths = "100 pt;100 pt;100 pt;100 pt;100 pt"
ListBox2.RowSource = Sheets("Liste des pièces").Range("A6:A25,C6:C25,J6:J25,K6:K25,AG6:AG26").Address

End Sub


Mais ça me donne pas le résultat souhaitable.


Merci pour votre aide
 

youky(BJ)

XLDnaute Barbatruc
Bonjour,
Comme ceci
si j'ai bien compris, . . .
pas déclaré mes variables à faire si besoin
Bruno
VB:
Private Sub UserForm_Initialize()
With Sheets("Liste des pièces") 'ou Feuil1
ListBox2.ColumnCount = 7
ListBox2.ColumnHeads = True
ListBox2.ColumnWidths = "100 pt;100 pt;100 pt;100 pt;100 pt"
For k = 6 To 25
ListBox2.AddItem Cells(k, 1)
ListBox2.List(i, 1) = .Cells(k, 3)
ListBox2.List(i, 2) = .Cells(k, 10)
ListBox2.List(i, 3) = .Cells(k, 11)
ListBox2.List(i, 4) = .Cells(k, 33)
i = i + 1
Next
End With
End Sub
 

job75

XLDnaute Barbatruc
Bonjour Sa Mariam, Bruno,
mais ya un petit soucis c'est que les noms des colonnes restent vide
Pour que les en-têtes des colonnes s'affichent il faut utiliser la propriété RowSource, et pour cela utiliser une feuille auxiliaire :
VB:
Private Sub UserForm_Initialize()
ListBox2.ColumnCount = 7
ListBox2.ColumnHeads = True
ListBox2.ColumnWidths = "100 pt;100 pt;100 pt;100 pt;100 pt"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si la feuille n'existe pas
Sheets("Aux").Delete 'supprime la feuille auxiliaire
On Error GoTo 0
With Sheets.Add(Before:=Sheets(1)) 'recrée la feuille auxiliaire
    Sheets("Liste des pièces").Range("A1:AG25").Copy .[A1]
    .Range("B:B,D:I,L:AF").Delete 'supprime les colonnes inutiles
    ListBox2.RowSource = .[A6:E25].Address(External:=True)
    .Name = "Aux" 'feuille renommée
    .Visible = xlSheetHidden 'feuille masquée
End With
Sheets("Liste des pièces").Activate
Application.ScreenUpdating = True
End Sub
Bien entendu les en-têtes doivent se trouver en ligne 5.

A+
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

VB:
Dim ColVisu(), LargeurCol(), Rng
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set Rng = f.Range("A2:AG" & f.[A65000].End(xlUp).Row)   ' Adapter
  ColVisu = Array(1, 3, 10, 11, 33)                                               ' Adapter
  LargeurCol = Array(100, 50, 100, 100, 100)                           ' Adapter
  Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
  Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
  Me.ListBox1.List = Application.Index(Rng, Evaluate("Row(1:" & Rng.Rows.Count & ")"), ColVisu)
  EnteteListBox
End Sub

Sub EnteteListBox()
    i = 0
    x = Me.ListBox1.Left + 8
    Y = Me.ListBox1.Top - 12
    For Each c In ColVisu
      i = i + 1
      Me("label" & i).Caption = Rng.Offset(-1).Item(1, c)
      Me("label" & i).Top = Y
      Me("label" & i).Left = x
      Me("label" & i).Height = 24
      Me("label" & i).Width = LargeurCol(i - 1)
      x = x + LargeurCol(i - 1)
    Next
End Sub


Boisgontier
 

Pièces jointes

  • ListBoxMultiColonnesDisc1.xls
    77.5 KB · Affichages: 5
Dernière édition:

Sa Mariam

XLDnaute Nouveau
Bonjour,

VB:
Dim ColVisu(), LargeurCol(), Rng
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set Rng = f.Range("A2:AG" & f.[A65000].End(xlUp).Row)   ' Adapter
  ColVisu = Array(1, 3, 10, 11, 33)                                               ' Adapter
  LargeurCol = Array(100, 50, 100, 100, 100)                           ' Adapter
  Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
  Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
  Me.ListBox1.List = Application.Index(Rng, Evaluate("Row(1:" & Rng.Rows.Count & ")"), ColVisu)
  EnteteListBox
End Sub

Sub EnteteListBox()
    i = 0
    x = Me.ListBox1.Left + 8
    Y = Me.ListBox1.Top - 12
    For Each c In ColVisu
      i = i + 1
      Me("label" & i).Caption = Rng.Offset(-1).Item(1, c)
      Me("label" & i).Top = Y
      Me("label" & i).Left = x
      Me("label" & i).Height = 24
      Me("label" & i).Width = LargeurCol(i - 1)
      x = x + LargeurCol(i - 1)
    Next
End Sub


Boisgontier
Merciii
 

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla