XL 2010 probléme sur configuration listview

reinruof77

XLDnaute Occasionnel
bonjour a tous et BONNE ANNEE

le fichier test ci joint fonctionne très bien mais je n'arrive pas a étendre la sélection a l'avoir sur les 48 colonnes.

je fait une recherche via 2 combobox lier (via un module de classe) ce qui m'affiche dans la listview puis je clic sur la ligne et récupérer les données dans les textbox .

mais je ne sait pas qu'elle ligne de code sont a modifier pour
1) récupérer toute les colonnes
2) quand je clic les recuperés dans mes textbox.

je sait que je doit ajouté des textbox (48 en tout ) .
voici le code .
VB:
Option Explicit
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim WithEvents CBL As ComboBoxLiés
' Dim TLgn() As Long ' Ce sera normalement la liste des numéros de lignes de CBL.PlgTablo copiées dans la ListView   ON N'EN A PEUT ÊTRE PAS BESOIN
Dim LCou As Long ' Ligne courante dans CBL.PlgTablo, c'est à dire celle sélectionnée dans ListView1



Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()
Set CBL = New ComboBoxLiés
CBL.Plage PlgUti(Feuil1.[A3])
CBL.Add Me.ComboBox1, "N"
CBL.Add Me.ComboBox2, "AB"
CBL.Actualiser

'Application.FullScreen = True
'Application.WindowState = xlNormal

With ListView1
   .View = lvwReport
   .FullRowSelect = True
   .Gridlines = True
   .ColumnHeaders.Add , , Cells(2, 1), 50 '1
   .ColumnHeaders.Add , , Cells(2, 2), 50 '1
   .ColumnHeaders.Add , , Cells(2, 3), 50 '2
   .ColumnHeaders.Add , , Cells(2, 4), 50 '3
   .ColumnHeaders.Add , , Cells(2, 5), 160 '4
   .ColumnHeaders.Add , , Cells(2, 6), 200 '5
   .ColumnHeaders.Add , , Cells(2, 7), 210 '6
   .ColumnHeaders.Add , , Cells(2, 8), 200 '7

   .ColumnHeaders.Add , , Cells(2, 9), 50 '9
  .ColumnHeaders.Add , , Cells(2, 10), 50 '10
.ColumnHeaders.Add , , Cells(2, 11), 70 '11
   .ColumnHeaders.Add , , Cells(2, 12), 50 '12
  .ColumnHeaders.Add , , Cells(2, 13), 50 '13
   .ColumnHeaders.Add , , Cells(2, 14), 50 '14
   .ColumnHeaders.Add , , Cells(2, 15), 50 '15
   .ColumnHeaders.Add , , Cells(2, 16), 50 '16
   .ColumnHeaders.Add , , Cells(2, 17), 50 '17
   .ColumnHeaders.Add , , Cells(2, 18), 50 '18
   .ColumnHeaders.Add , , Cells(2, 19), 50 '19
   .ColumnHeaders.Add , , Cells(2, 20), 50 '20
   .ColumnHeaders.Add , , Cells(2, 21), 50 '21
   .ColumnHeaders.Add , , "Ligne", 50, lvwColumnLeft '22
   End With

'   For I = 1 To 6
      ' Me("Textbox" & i).Visible = False
'   Next

End Sub

Private Sub BtnEffacer_Click()
CBL.Nettoyer
End Sub

Private Sub CBL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
Me.ListView1.ListItems.Clear
LCou = 0
End Sub

Private Sub CBL_Résultat(Lignes() As Long)
Dim T() As Variant, N As Long, L As Long, C As Long
T = CBL.PlgTablo.Resize(, 6).Value
For N = 1 To UBound(Lignes)
   L = Lignes(N)
   With ListView1.ListItems.Add(Text:=T(L, 1))
      For C = 2 To 6: .ListSubItems.Add Text:=T(L, C): Next C
      .ListSubItems.Add Text:=L
      End With
   Next N
End Sub

Private Sub Listview1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim T(), C As Long
LCou = ListView1.ListItems(Item.Index).ListSubItems(7 - 1).Text
T = CBL.PlgTablo.Rows(LCou).Resize(, 6).Value
For C = 1 To 6: Me("TextBox" & C).Text = T(1, C): Next C
End Sub




Public Function ScreenWidth() As Long
Const SM_CXSCREEN As Long = 0
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function
Public Function PointsPerPixel() As Double
Dim hdc As Long
Dim lDotsPerInch As Long
Const LOGPIXELSX As Long = 88, POINTS_PER_INCH = 0 'Pas trouvé ce truc POINTS_PER_INCH
hdc = GetDC(0)
lDotsPerInch = GetDeviceCaps(hdc, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hdc
End Function
Public Function ScreenHeight() As Long
Const SM_CYSCREEN As Long = 1
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
End Function






Private Sub CommandButton5_Click()
strNom = Application.GetSaveAsFilename(ActiveSheet.Name, "Fichier Excel (*.xls),*.xls")
Application.DisplayAlerts = False
  Sheets(Array("Feuil1")).Select
  Sheets(Array("Feuil1")).Copy
       
  ActiveWorkbook.SaveAs strNom
    ActiveWindow.Close
    ActiveWorkbook.Save
    Dim Var As String
Var = "sauvegarde du fichier effectuer A BIENTOT."
MsgBox Var
'Application.Quit
ActiveWorkbook.Close
Unload Userform1
End Sub




Private Sub CommandButton1_Click()    'modifier ajouter
    Dim T(), C As Long
If LCou = 0 Then
   LCou = CBL.PlgTablo.Rows.Count
   With CBL.PlgTablo.Rows(LCou): .Copy: .Insert: End With
   LCou = LCou + 1: End If
ReDim T(1 To 1, 1 To 6)
For C = 1 To 6: T(1, C) = Me("TextBox" & C).Text: Next C
CBL.PlgTablo.Rows(LCou).Resize(, 6).Value = T
CBL.Actualiser
MsgBox "MODIFICATION EFFECTUER."
    Unload Me
    Userform10.Show
   
End Sub




Private Sub CommandButton4_Click()
    Unload Me
End Sub


merci de votre aide
demande faite sur un autre forum rester sans réponse.
https://forum.excel-pratique.com/excel/listview-et-modification-t87507.html
 

Pièces jointes

  • LISTVIEW.xlsm
    110.5 KB · Affichages: 51

ChTi160

XLDnaute Barbatruc
Bonsoir reinruof77
Bonsoir Le Fil,Le Forum
Une Bonne Année à Toutes et Tous .
petites demandes :
Tu veux charger dans la ListView1 les 48 Colonnes ?
et ensuite récupérer les données de la Ligne sélectionnée dans la ListView , dans la série de TextBox (48)
dans l'attente .
Bonne fin de Soirée
Amicalement
Jean Marie
 

Lone-wolf

XLDnaute Barbatruc
Bonsoir et bonne année à tous.:)

Sans avoir regardé le fichier. Un exemple

VB:
Private Sub ListView1_ItemClick(ByVal item As MSComctlLib.ListItem)

    On Error Resume Next

    ListView1.SelectedItem = True

    With Sheets(1)
        For i = 1 To 7
            Set ItemProd = ListView1.SelectedItem
            rw = Application.Match(ItemProd.SubItems(1), .Columns(2), 0)
            Controls("TextBox" & i) = .Cells(rw, i)
        Next i
        TextBox4 = Format(.Cells(rw, 4), "dd.mm.yyyy")
        TextBox5 = Format(.Cells(rw, 5), "hh:mm")
        TextBox6 = Format(.Cells(rw, 6), "hh:mm")
    End With
End Sub
 

Bebere

XLDnaute Barbatruc
comme suit
bonsoir Lone-wolf
meilleurs voeux à tous
emploi de la propriété key de listvieww
Code:
Private Sub CBL_Résultat(Lignes() As Long)
Dim T() As Variant, N As Long, L As Long, c As Long
T = CBL.PlgTablo.Resize(, 48).Value
For N = 1 To UBound(Lignes)
   L = Lignes(N)
   With ListView1.ListItems.Add(Key:="A" & L, Text:=T(L, 1))
      For c = 2 To 48: .ListSubItems.Add Text:=T(L, c): Next c
      .ListSubItems.Add Text:=L
      End With
   Next N
End Sub

Private Sub Listview1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim T(), c As Long
LCou = Mid(ListView1.ListItems(Item.Index).Key, 2) 'ListSubItems(7 - 1).Text
T = CBL.PlgTablo.Rows(LCou).Resize(, 48).Value
For c = 1 To 48: Me("TextBox" & c).Text = T(1, c): Next c
End Sub
 

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert