XL 2010 [Résolu] Afficher résultats par dates dans Listview

[Lone-wolf]

Bonjour à toutes et à tous

En PJ et dans le formulaire UsfGestionES, j'aissaie d'afficher par dates les entrées et les sorties des différents articles. Je ne sais pas se qui se passe, la listview n'affiche aucuns résultas malgré une recherche avec Find.

J'ai aussi un souci concernant le format Date dans les Combobox's, elles affichent le format "dd/mm/yyyy" et moi j'aimerais qu'elles soient au format "dd.mm.yyyy". Les feuilles sont "Entrees" et "Sorties" du classeur Base qui se trouve dans le sous-dossier.

Merci d'avance pour l'aide que vous apporterez.

 

[Lone-wolf]

Hi Bebere,

Ok, je regarde ça.

A+

 

[Lone-wolf]

Re Bebere,

désolé, ce n'est pas ça. Moi aussi je me suis basé sur la recherche avec Item.SubItems; mais celui-ci supprime une autre ligne malgré que j'avais mis avant item = Listview1.SelectedItem.

En mettant la combo et la textbox en static comme moi j'ai fait, il n'y a pas d'erreurs, puisqu'il mémorise la valeur exacte des contrôles.

Il faudrais juste que tu fasse la macro pour Sauvegarde. Comme les articles dont décalés par rapport au numéro de commande, je ne sais pas comment l'écrire. J'ai essaié avec la macro qui est dans modifcommandes, mais rien à faire.

 

[Bebere]

bonjour Lone-wolf,le forum
oui ,j'ai oublié une partie du code(pour sauvegarde), et un test dans wsdc
If .Cells(i, 2) = Val(MonItem) And .Cells(i, 3) = MonItem.ListSubItems(1) Then
il y a une différence ds les commandes + et &
ex:Trousse multifonction + recharge parfum 25cl,Trousse multifonction&recharge parfum 25cl
d'où il se supprime d'un côté et pas de l'autre

 

[Lone-wolf]

Bonjour Bebere,

je te remet le fichier Base corrigé pour test. Dis-mois si ça joue, j'ai aussi un souci concernant les articles, comme il y a des doublons, faut qu'elle supprime la ligne exacte. En faisant un test avec mon ancien code c'est ce qui est arrivé, ça supprime le même article, même si ce n'est pas la même commande.

 

[Bebere]

Lone-wolf voilà un code plus complet testé avec le dernier fichier base

Private Sub CmdActualiser_Click()
Dim plage As Range, cel As Range, lig%, j%, x%, rw, i
Dim derl%, rart, ncom, debut, fin

If Me.CmbComm <> "" Then

If Me.CheckBox1 Then
With WsRetours
lig = .Range("a65536").End(xlUp).Row + 1
For j = 1 To Me.ListView1.ListItems.Count
.Cells(lig, 1) = lig - 1
.Cells(lig, 2) = CmbComm.Value
.Cells(lig, 3) = TxtClient
.Cells(lig, 4) = Me.ListView1.ListItems(j).SubItems(1)
.Cells(lig, 5) = Me.ListView1.ListItems(j).SubItems(2)
.Cells(lig, 6) = Me.ListView1.ListItems(j).SubItems(3)
.Cells(lig, 7) = Me.ListView1.ListItems(j).SubItems(4)
lig = lig + 1
Next j
'If .Cells(lig, 7) <> "" Then: MsgBox "Les données ont été inscrites.", , "LES MILLES MERVEILLES" ': Exit Sub
.Columns.AutoFit '.Range("A:G")
End With

'factures
WsFact.Range("A" & Me.CmbComm.ListIndex + 2).EntireRow.Delete
Me.CmbComm.List = WsFact.Range("b2:b" & WsFact.Range("b65536").End(xlUp).Row).Value
Me.CmbComm = ""
lig = WsFact.Range("a65536").End(xlUp).Row
For i = 2 To lig
WsFact.Range("A" & i) = i - 1
Next i

'commandes
WsC.Range("A" & Me.CmbComm.ListIndex + 2).EntireRow.Delete
lig = WsC.Range("a65536").End(xlUp).Row
For i = 2 To lig
WsC.Range("A" & i) = i - 1
Next i

With WsDC 'détail cde
derl = .Range("A65536").End(xlUp).Row
For j = Me.ListView1.ListItems.Count To 1 Step -1
For i = derl To 2 Step -1
If .Cells(i, 2) = Me.ListView1.ListItems(j) And .Cells(i, 3) = Me.ListView1.ListItems(j).SubItems(1) Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
Next j
'.Rows.Height = 12.75
Call MontantFacture
End With

With WsStock
For j = Me.ListView1.ListItems.Count To 1 Step -1
rw = Application.Match(Me.ListView1.ListItems(j).SubItems(1), .Columns(3), 0)
.Cells(rw, 9) = .Cells(rw, 9) - Me.ListView1.ListItems(j).SubItems(2)
.Cells(rw, 11) = .Cells(rw, 11) + Me.ListView1.ListItems(j).SubItems(2)
' TxtStockReel = .Cells(rw, 11)
Next j
End With

With WsSav
debut = .Columns(2).Find(Val(Me.CmbComm), LookIn:=xlValues, lookat:=xlWhole).Row
fin = .Range("B" & debut).End(xlDown).Row

For i = fin To debut Step -1
If .Cells(i, 2) = MonItem.ListSubItems(1) Then
cel.EntireRow.Delete
End If
Next i
'.Rows.Height = 12.75
End With

Else
If Not MonItem Is Nothing Then

With WsRetours
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1) = lig - 1
.Cells(lig, 2) = CmbComm.Value
.Cells(lig, 3) = TxtClient
.Cells(lig, 4) = MonItem.SubItems(1)
.Cells(lig, 5) = TxtRetours.Value
.Cells(lig, 6) = MonItem.SubItems(3)
.Cells(lig, 7) = MonItem.SubItems(4)
'If .Cells(lig, 7) <> "" Then: MsgBox "Les données ont été inscrites.", , "LES MILLES MERVEILLES" ': Exit Sub
.Columns.AutoFit '.Range("A:G")
End With

'On Error Resume Next
With WsDC 'détail cde
derl = .Range("A65536").End(xlUp).Row
For i = 2 To derl
If .Cells(i, 2) = Val(MonItem) And .Cells(i, 3) = MonItem.ListSubItems(1) Then
.Cells(i, 1).EntireRow.Delete
Exit For
End If
Next i
'.Rows.Height = 12.75
Call MontantFacture
End With

With WsStock
rw = Application.Match(MonItem.SubItems(1), .Columns(3), 0)
.Cells(rw, 9) = .Cells(rw, 9) - TxtRetours
.Cells(rw, 11) = .Cells(rw, 11) + TxtRetours
TxtStockReel = .Cells(rw, 11)
End With

With WsSav
debut = .Columns(2).Find(Val(Me.CmbComm), LookIn:=xlValues, lookat:=xlWhole).Row
fin = .Range("B" & debut).End(xlDown).Row

For i = fin To debut Step -1
If .Cells(i, 2) = MonItem.ListSubItems(1) Then
.Cells(i, 2).EntireRow.Delete
If i - 1 = debut Then
.Cells(debut, 2).EntireRow.Delete 'ligne Me.CmbComm
.Cells(debut + 1, 2).EntireRow.Delete 'ligne vide
Else
Exit For
End If
End If
Next i
'.Rows.Height = 12.75
End With
End If
'ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End If
End Sub

 

[Lone-wolf]

Hello Bebere

Tu as de nouveau oublié le 'CODE' LOL .
Me voilà maintenant obligé de le couper en morceau, ça sort de l'écran MDR

 

[grisan29]

bonsoir a vous
lonewolf je ne peux regarder ton fichier car je n'ai pas ocx du datepicker et du coup çà bug

 

[Lone-wolf]

Re Bebere

Nickel! . Testé et approuvé. Merci infiniment.

Au faite, j'ai mis la macro Suppression-Doublons dans Base, est-ce que ça peut causer problème?

 

[Lone-wolf]

Bonsoir Pascal,

soit tu supprime les lignes si reférent, soit tu installe l'ocx en PJ.

 

[Bebere]

pourtant j'ai cliqué la dernière icône à droite,à côté de Tx

 

[Lone-wolf]

Tu parle de quoi Bebere, je ne comprends pas.

 

[Bebere]

en réponse à #50

 

[Lone-wolf]

Mais ce n'est pas sur la clé anglaise qu'il faut cliquer pour inserer un code. C'est sur l'icône qui est entre l'icône cinéma et l'icone disquette. Là tu as code > Langue > code VB et tu y colle le code.

 

[Lone-wolf]

Bonjour Bebere,

hier j'ai parlé trop vite (C'est par-ce que j'ai fait un test seulement avec une ligne sur l'ordi de ma femme). Il y a un problème avec la suppression de toute la commande. Dans Commandes et Sauvegarde les lignes ne sont pas supprimées.

J'ai l'erreur Variable de block with non définie sur les lignes:
debut = .Columns(2).Find(Val(Me.CmbComm), LookIn:=xlValues, lookat:=xlWhole).Row

Sorry

EDIT: Stop. J'ai corrigé le problème en écivant comme ceci

'factures
With WsFact
rw = Application.Match(Val(CmbComm), .Columns(2), 0)
.Cells(rw, 1).EntireRow.Delete
End With

'commandes
With WsC
rw = Application.Match(Val(CmbComm), .Columns(2), 0)
.Cells(rw, 1).EntireRow.Delete
End With

'sauvegarde
With WsSav
    rw = WorksheetFunction.Match(Val(Me.CmbComm), .Columns(2), 0)
    k = .Cells(rw, "B").CurrentRegion.Rows.Count + 1
    .Cells(rw, "B").Resize(k).EntireRow.Delete
End With

 

[Bebere]

bonjour Lone-wolf
effectivement il manquait commandes et factures
changements dans bouton actualiser et userform_initialise
je vérifierai encore ce soir,maintenant plus le temps
bonne journée