Affichage ListItems décalé de 7 lignes

hemardjean

XLDnaute Occasionnel
Bonjour le forum
J’ai fait des changements dans l’UserForm j’ ai ajouté une vingtaine de TextBox puis j’ai ajouté dans les codes de l’UserForm des
.ColumnHeaders.Add

puis dans la liste les,
ListItems(cellule - 3).ListSubItems.Add , "B" & cellule, Range("B" & cellule).Text

Mais suite à tous ces changements lorsque je veux utiliser le formulaire et que je sélectionne la 1er ligne la ListView les TextBox qui s’affichent sont décalés de six lignes et la je sèche voici les codes :
______________________________________________________________
Dim ligne As Long, Idx As Long
Dim index1 As Integer, A As Integer, cellule As Integer, L As Integer
______________________________________________________________
Private Sub CommandButton3_Click()
derligne = Sheets("BD1").Cells(65535, 1).End(xlUp).Row + 1
For i = 1 To 47
Cells(derligne, i) = Me.Controls("Textbox" & i)
Next i
Call Remplir_Liste(ComboBox1.Text)
'Rows("5:5").Select
Rows(derligne - 1).Select
Selection.Copy
Range("A" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For i = 1 To 47
Me.Controls("Textbox" & i) = ""
Next i
Call Remplir_Combobox
End Sub
_____________________________________________________
Private Sub UserForm_initialize()
Dim NBentree As Long, i As Integer
A = Cells(65535, 3).End(xlUp).Row
NBentree = Sheets("BD1").Cells(65535, 1).End(xlUp).Row - 2
Call Remplir_Combobox
With ListView1
.View = lvwReport
.FullRowSelect = True
.Gridlines = True

.ColumnHeaders.Add , , Cells(2, 1), 50
.ColumnHeaders.Add , , Cells(2, 2), 50
.ColumnHeaders.Add , , Cells(2, 3), 50
à
.ColumnHeaders.Add , , Cells(2, 64), 50
.ColumnHeaders.Add , , Cells(2, 65), 50
.ColumnHeaders.Add , , "Ligne", 50, lvwColumnLeft
End With
For i = 1 To 65
' Me("Textbox" & i).Visible = False
Next
End Sub
_____________________________________________________________
Private Sub ComboBox1_Change()
Dim i As Byte, L As Long
' Stop
L = Me.ComboBox1.ListIndex
Call Remplir_Liste(ComboBox1.Text)
End Sub
________________________________________________
Private Sub CommandButton1_Click() 'modifier
Dim i As Byte, L As Long
' Stop
Application.ScreenUpdating = False
L = Me.ComboBox1.ListIndex
'
For i = 1 To 65
Cells(ligne, i) = Me.Controls("Textbox" & i)
Next i
'
Call Remplir_Liste(ComboBox1.Text)
Call Remplir_Combobox
Application.ScreenUpdating = True
For i = 1 To 65
Me.Controls("Textbox" & i) = ""
Next i
End Sub
__________________________________________________
Private Sub CommandButton2_Click() 'supprimer
Dim VarReponse As String, L As Long, Li As Long
VarReponse = MsgBox("Effacer les données?", vbYesNo, "Alerte")
If VarReponse = vbNo Then Exit Sub
Application.ScreenUpdating = False
For L = Me.ListView1.ListItems.Count To 1 Step -1
If Me.ListView1.ListItems(L).Selected = True Then
Li = Mid(ListView1.ListItems(L).Key, 2)
Rows(Li).Delete Shift:=xlUp
ListView1.ListItems.Remove (L)
End If
Next
Application.ScreenUpdating = True
End Sub
___________________________________________________
Private Sub CommandButton4_Click()
Unload Me
End Sub
_____________________________________________________
Private Sub OptionButton1_Click() 'ajouter
Dim i As Integer
If OptionButton1 Then
Me.CommandButton1.Enabled = False
Me.CommandButton2.Enabled = False
Me.CommandButton3.Enabled = True
For i = 1 To 65
Me("Textbox" & i).Visible = True
Next
Me.ListView1.MultiSelect = False
End If
End Sub
_______________________________________________
Private Sub OptionButton2_Click() 'modifier
Dim i As Integer
If OptionButton2 Then
Me.CommandButton1.Enabled = True
Me.CommandButton2.Enabled = False
Me.CommandButton3.Enabled = False
For i = 1 To 65
Me("Textbox" & i).Visible = True
Next
Me.ListView1.MultiSelect = False
End If
End Sub
_________________________________________
Private Sub OptionButton3_Click() 'supprimer
Dim i As Integer
If OptionButton3 Then
Me.CommandButton1.Enabled = False
Me.CommandButton2.Enabled = True
Me.CommandButton3.Enabled = False
For i = 1 To 65
Me("Textbox" & i).Visible = False
Next
Me.ListView1.MultiSelect = True
End If
End Sub
_______________________________________________
Sub Remplir_Combobox()
Dim SourceSheet
Dim L As Long, MonDico As Object
Dim B As Range
Dim B1
Set MonDico = CreateObject("Scripting.Dictionary")
B1 = "TOUS"
If Not MonDico.Exists(B1) Then MonDico.Add B1, B1
For Each B In Range("B1:B" & Cells(65535, 1).End(xlUp).Row)
If Not MonDico.Exists(B.Value) Then MonDico.Add B.Value, B.Value
Next B
ComboBox1.List = MonDico.items
'ComboBox1.AddItem "TOUS"
' ComboBox1.Text = "TOUS"
'tri
Dim x, i, j, temp
With ComboBox1
' trie alphabetiques de noms
For i = 1 To .ListCount - 1
For j = 1 To .ListCount - 1
If UCase(.List(i)) < UCase(.List(j)) Then
temp = .List(j)
.List(j) = .List(i)
.List(i) = temp
End If
Next j
Next i
End With
Set MonDico = Nothing
ComboBox1.Text = "TOUS"
End Sub
_______________________________________
Sub Remplir_Liste(ByVal Quoi As String)
Dim cellule As Integer, Compteur As Integer
Sheets("BD1").Activate
With ListView1
.ListItems.Clear
For cellule = 4 To Cells(65535, 4).End(xlUp).Row ' Step 1 'on rajoute 2 car il commence à partir de la ligne 3
If Quoi = "TOUS" Then
.ListItems.Add , "A" & cellule, Range("A" & cellule)
.ListItems(cellule - 3).ListSubItems.Add , "B" & cellule, Range("B" & cellule).Text
.ListItems(cellule - 3).ListSubItems.Add , "C" & cellule, Range("C" & cellule).Text
.ListItems(cellule - 3).ListSubItems.Add , "D" & cellule, Range("D" & cellule).Text
à
.ListItems(cellule - 3).ListSubItems.Add , "BL" & cellule, Range("BL" & cellule).Text
.ListItems(cellule - 3).ListSubItems.Add , "BM" & cellule, Range("BM" & cellule).Text
.ListItems(cellule - 3).ListSubItems.Add , , cellule
Else
' Stop
If Range("B" & cellule) = Quoi Then
.ListItems.Add , "A" & cellule, Range("A" & cellule)
Compteur = .ListItems.Count
.ListItems(Compteur).ListSubItems.Add , "B" & cellule, Range("B" & cellule).Text
.ListItems(Compteur).ListSubItems.Add , "C" & cellule, Range("C" & cellule).Text
à
.ListItems(Compteur).ListSubItems.Add , "BK" & cellule, Range("BK" & cellule).Text
.ListItems(Compteur).ListSubItems.Add , "BL" & cellule, Range("BL" & cellule).Text
.ListItems(Compteur).ListSubItems.Add , "BM" & cellule, Range("BM" & cellule).Text
.ListItems(Compteur).ListSubItems.Add , , cellule
End If
End If
Next cellule

End With
End Sub
___________________________________________________
Private Sub Listview1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Byte
ligne = ListView1.ListItems(Item.Index).ListSubItems(18 - 1).Text
'Stop
'If Me.OptionButton2 Then 'modifier
TextBox1.Text = Cells(ligne, 1) 'ListView1.ListItems(Item.Index).Text
For i = 1 To 65
Me("TextBox" & i).Text = Cells(ligne, i) 'ListView1.ListItems(Item.Index).ListSubItems(i - 1).Text
Next i
'End If
End Sub
__________________________________________________
Merci encore de votre aide
Cordialement
"j'ai ajouté une pièce jointe oubliée au 1er message"
 

Pièces jointes

  • compositions et integration 1213.xlsm
    234.3 KB · Affichages: 51
Dernière édition:

Discussions similaires

Réponses
11
Affichages
296

Statistiques des forums

Discussions
312 225
Messages
2 086 411
Membres
103 201
dernier inscrit
centrale vet