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
 

Sa Mariam

XLDnaute Nouveau
Bonjour, Merci pour votre aide ça a marché mais ya un petit soucis c'est que les noms des colonnes restent vide
 

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+
 

youky(BJ)

XLDnaute Barbatruc
Bonjour Gérard,
Toujours mieux et une longueur d'avance sur moi.
Je n'ai qu'un mot à dire Gggrrrrr!!!
A+
 

BOISGONTIER

XLDnaute Barbatruc
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
 

Fichiers joints

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
 

Haut Bas