Correction Code listveiw

[mido21]

Bonsoir
S'il vous plaît examiner le code et correct

Private Sub CommandButton7_Click()

  ListView1.ListItems.clear

'  On Error Resume Next

  Dim RowNumber As Long

  Dim MaxRow As Long

  txt1 = Me.n1.Value: txt2 = Me.n2.Value:  txt3 = Me.n3.Value

  MaxRow = sheet5.Cells(sheet5.Rows.Count, 2).End(xlUp).Row

''''''''''''''''''''''''''''''''''''''

  With ListView1

  For RowNumber = 5 To MaxRow

  If txt1 = "" Then GoTo 10

  If InStr(1, sheet5.Cells(RowNumber, 9), txt1, 1) = 1 Or InStr(1, sheet5.Cells(RowNumber, 12), txt1, 1) = 1 Then

10  If txt2 = "" Then GoTo 30

  If Format(CDate(sheet5.Cells(RowNumber, 4)), "yyyy/mm/dd") >= Format(CDate(txt2), "yyyy/mm/dd") Then

30  If txt3 = "" Then GoTo 40

  If Format(CDate(sheet5.Cells(RowNumber, 4)), "yyyy/mm/dd") <= Format(CDate(txt3), "yyyy/mm/dd") Then

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

10  .ListItems.Add , , sheet5.Cells(RowNumber, 2).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 3).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 4).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 5).Value

  If Me.n1.Text = sheet5.Cells(RowNumber, 9).Text Then

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 6).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , "0"

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 8).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 9).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 15).Value

  ElseIf Me.n1.Text = sheet5.Cells(RowNumber, 11).Text Then

  .ListItems(RowNumber - 4).ListSubItems.Add , , "0"

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 7).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 8).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 11).Value

  .ListItems(RowNumber - 4).ListSubItems.Add , , sheet5.Cells(RowNumber, 15).Value

  Else

  End If: End If: 'End If: End If

  Next RowNumber

  End With

End Sub

 

[ChTi160]

Bonjour mido
Bonjour le fil,Le Forum
arffffffffffffffff pas évident pour les Non Visionnaires que nous sommes , de travailler en aveugle !!!!
pas de fichier et faut travailler
voila ce que j'ai imaginé avec ce que j'avais Lol ???????
aucune Idée de ce qu''est , par exemple n1 , n2, n3 ,,,,,,,
ou ce que veut dire Goto 30 , 40 etc etc

Private Sub CommandButton1_Click()
ListView1.ListItems.Clear
Dim RowNumber As Long
Dim MaxRow As Long
Dim F1 As Worksheet
txt1 = Format(Date, "dd/mm/yyyy"): txt2 = Format(Date, "dd/mm/yyyy"): txt3 = Format(Date, "dd/mm/yyyy")
Dim LstVitem As MSComctlLib.ListItem
Dim Dte_Compare As Date
Set F1 = Worksheets("Test") ' feulle Cible
With F1 'Avec la feuille Cible
MaxRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'On détermine la dernière ligne non vide de la Colonne 2
End With
With UserForm1 'Avec le Userform
With .ListView1 'Avec la ListView
  With .ListItems ' avec les éventuelles Ligne
       .Clear 'on les éfface
For RowNumber = 2 To MaxRow 'Pour chaque ligne
  Dte_Compare = Format(CDate(F1.Cells(RowNumber, 4)), "yyyy/mm/dd") 'On récupére la Date de la Colonne 4 de la Ligne considérée
If txt1 = "" Or InStr(1, F1.Cells(RowNumber, 9), txt1, 1) = 1 Or InStr(1, F1.Cells(RowNumber, 12), txt1, 1) = 1 Then GoTo 10
If txt2 = "" Or Dte_Compare >= Format(CDate(txt2), "yyyy/mm/dd") Then GoTo 10
If txt3 = "" Or Dte_Compare <= Format(CDate(txt3), "yyyy/mm/dd") Then GoTo 10
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Set LstVitem = .Add(, , F1.Cells(RowNumber, 2).Value)
With LstVitem
      .ListSubItems.Add , , F1.Cells(RowNumber, 3).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 4).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 5).Value
If Me.txt1.Text = F1.Cells(RowNumber, 9).Text Then 'Me.n1?????
      .ListSubItems.Add , , F1.Cells(RowNumber, 6).Value
      .ListSubItems.Add , , "0"
      .ListSubItems.Add , , F1.Cells(RowNumber, 8).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 9).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 15).Value
  ElseIf Me.txt1.Text = F1.Cells(RowNumber, 11).Text Then 'Me.n1????
      .ListSubItems.Add , , "0"
      .ListSubItems.Add , , F1.Cells(RowNumber, 7).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 8).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 11).Value
      .ListSubItems.Add , , F1.Cells(RowNumber, 15).Value
  Else
End If
End With 'LstVitem
Next RowNumber
  End With
End With 'ListView
End With 'Me
10:
MsgBox "Vide ,Non conforme"
End Sub

pas de test car pas de Fichier Exemple Lol Normal !!!!!!
Bonne Journée
Amicalement
Jean marie

 

[mido21]

Bonjour Jean marie
excellent excellent excellent excellent excellent excellent
Merci beaucoup
=====================================
Peut-on recueillir une colonne dans ListView
Exemple listbox

Application.Sum(Application.Index(Me.ListBox1.List, , 4))

======================================================
Peut-on recueillir un certain nombre d'enregistrements dans listview

ListBox1.ListCount

==========================================
Je vais envoyer un fichier pour me aider à remplir

 

[ChTi160]

Bonsoir
Oui un fichier ! car on a rien compris encore Lol
ListView ou ListBox ?????
Amicalement
Jean marie

 

[mido21]

Bonsoir Ce lien n'existe plus
Voici un exemple qui fonctionne dans une bonne façon

 

[ChTi160]

Bonsoir mido21
j’espère que tu vas bien §
pour que ce soit parfait , car je pense que toi tu sais ce que tu veux faire de ce Fichier !
Et bien Nous Non !
Tu devrais nous dire comment doit fonctionner ton Fichier ,il y a des textBox une ListView ect etc
mais on dois faire quoi pour tester ?
mets donc un exemple : tu nous dis il faut mettre ceci la et ceux ci la etc etc;; et je veux ceux ci !
merci par avance ;
Amicalement
Jean marie

 

[mido21]

Bonsoir Ce lien n'existe plus
Puis-je récupérer la colonne à l'intérieur( crdt) SubTotal(textbox.name)
Puis-je récupérer la colonne à l'intérieur( debt) TNour(textbox.name)

 

[mido21]

Aussi pourquoi ces codes ne fonctionnent pas

Private Sub CommandButton3_Click() 'FIRST RECORD BUTTON
On Error Resume Next
ListView1.ListIndex = 0
End Sub
Private Sub Cmdbutton4_Click() 'LAST RECORD BUTTON
On Error Resume Next
ListView1.ListIndex = ListView1.ListCount - 1
End Sub

 

[ChTi160]

Bon pas de réponse !
donc Arrêt du Suivi !!!!!

 

[mido21]

Bonsoir Ce lien n'existe plus
regrette peut-être pas la meilleure explication que
je vous remercie de réponses
sincère
mido