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]

Re Bebere

Pas de soucis. A+

 

[Lone-wolf]

Bonjour Bebere,

cette fois tout est ok. Voici la macro mais avec 2 boutons.

Private Sub CmdActualiser_Click()
Dim plage As Range, cel As Range, lig%, k%, rw
Dim Msg As Integer, id, art, num

Msg = MsgBox("Êtes-vous sûr de vouloir supprimer les données ?", vbYesNo, "LES MILLES MERVEILLES")
        If Msg = 6 Then
    
With ListView1
  id = .SelectedItem.Index
  .ListItems(id).Selected = True
  art = .ListItems(id).ListSubItems(1)

   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) = LvItem.SubItems(1)
.Cells(lig, 5) = TxtRetours.Value
.Cells(lig, 6) = LvItem.SubItems(3)
.Cells(lig, 7) = LvItem.SubItems(4)
.Columns.AutoFit
End With

With WsDC
Set plage = .Range("b2:b" & Range("b65536").End(xlUp).Row).Find(Val(CmbComm))
    For Each cel In plage
    Set cel = .Range("c2:c" & Range("c65536").End(xlDown).Row).Find(art)
            cel.Offset(0, 0).EntireRow.Delete xlUp
    Next cel
lig = .Range("a65536").End(xlUp).Row
For k = 2 To lig
.Cells(k, 1) = k - 1
Next k
Call MontantFacture
End With

With WsSav
Set plage = .Range("b2:b" & Range("b65536").End(xlUp).Row).Find(Val(CmbComm))
    For Each cel In plage
    Set cel = .Range("b2:b" & Range("b65536").End(xlDown).Row).Find(art)
            cel.Offset(0, 0).EntireRow.Delete xlUp
    Next cel
End With

With WsStock
rw = Application.Match(art, .Columns(3), 0)
.Cells(rw, 9) = .Cells(rw, 9) - TxtRetours
.Cells(rw, 11) = .Cells(rw, 11) + TxtRetours
TxtStockReel = .Cells(rw, 11)
End With
.ListItems.Remove id
            MsgBox "Données supprimées.", vbOK, "LES MILLES MERVEILLES"
            If Msg = 7 Then Exit Sub
End With
End If

End Sub

Private Sub CmdTout_Click()
Dim plage As Range, cel As Range
Dim Msg%, lig%, j%, k%
Dim id, art, num, nb, rw


Msg = MsgBox("Êtes-vous sûr de vouloir supprimer toute la commande ?", vbYesNo, "LES MILLES MERVEILLES")
    If Msg = 6 Then
With WsC
    rw = WorksheetFunction.Match(Val(CmbComm), .Columns(2), 0)
    .Cells(rw, 2).EntireRow.Delete
End With

With WsFact
    rw = WorksheetFunction.Match(Val(CmbComm), .Columns(2), 0)
    .Cells(rw, 2).EntireRow.Delete
End With

With ListView1
  id = .SelectedItem.Index
  art = .ListItems(id).ListSubItems(1)
    
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
.Columns.AutoFit
End With

With WsDC
    rw = WorksheetFunction.Match(Val(CmbComm), .Columns(2), 0)
    nb = WorksheetFunction.CountIf(.Columns(2), Val(CmbComm))
    .Cells(rw, "B").Resize(nb).EntireRow.Delete
lig = .Range("a65536").End(xlUp).Row
For k = 2 To lig
.Cells(k, 1) = k - 1
Next k
Call MontantFacture
End With

With WsStock
For j = 1 To Me.ListView1.ListItems.Count
rw = rw + 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)
Next j
End With

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

            MsgBox "La commande à été supprimée.", vbOK, "LES MILLES MERVEILLES"
            If Msg = 7 Then Exit Sub
End With
End If
End Sub

A ++

 

[Bebere]

bonjour Lone-wolf
Je met ma version,hier c'était pas du tout çà
dans ta version tu parles de 2 msgbox(2 boutons)
Je teste 2010 pour le moment et dans outils, références
il y a MANQUANT: sur Microsoft Commun Controls-2
normalement il devrait être chez moi aussi
qu'en penses tu

 

[Lone-wolf]

Re Bebere,

J'ai ouvert le fichier, mais c'est la dernière version que j'ai mit. Je ne vois pas de changement dans le formulaire retours.

EDIT: en pj, le dernier fichier où j'ai apporté des modifications pour la feuille facturation, il manquait la fonction arrondi et ajouté une macro pour la feuille stock afin de faire une mise à jour de la colonne stock réel lors de la suppression de l'article ou de la commande. Pour les msgbox, c'est bien de les mettres, mieux vaut éviter de supprimer une commande par inadvertance.

 

[Bebere]

Bien Lone-wolf
je ferai les changements sur le dernier fichier et laisserai ton code en commentaire

 

[Lone-wolf]

Bonjour Bebere,

je ne sais pas si tu l'as remarqué, mais dans détails commandes, il y avait des éspaces en trop au lignes bagues. J'ai à nouveau mis à jour le fichier Base et supprimer la macro de mise à jour qui causait problème. Il manquait aussi la maj pour ventes produits et ventes catégories. J'ai tout repris à zéro et fait les modifications.

Comme je ne sais pas faire autrement, il y a pleins de boucles dans le formulaire retours, et sa rallentit l'exécution des macros; en revanche cette fois tout ce passe correctement. En PJ juste le fichier primaire.

 

[Bebere]

bonjour Lone-wolf
message bien reçu

 

[Bebere]

bonjour Lone-wolf
une version avec 2 optionbutton et ajout d'un code fastrun
tu peux l'employer pour tout le classeur appel fastrun false,fastrun true
base avait d'autres erreurs,version corrigée jointe

 

[Lone-wolf]

Bonjour René

J'ai regardé le fichier modifié en date d'aujourd'hui, mais pas testé. J'ai moi aussi touvé une nouvelle erreur dans la feuille ventes produits. Je ne comprends pas pourquoi il y avait un décalage dans la colonne catégories, mais j'ai corrigé.

Dans mon fichier en PJ, ce matin j'ai éffectué quelques prises de commandes. Avec UsfVisualise, quand j'ai voulu affiché les ventes du jour, j'ai eu le message d'erreur incompatibilité de type sur la ligne

If tbl(i, 1) = madate Then mondico(tbl(i, 2)) = mondico(tbl(i, 2)) + tbl(i, 3)

Parcontre pas d'erreur sur les autres dates ???

Le gros problème maintenant, c'est UsfCommandes qui me cause du souci. Au fure et à mesure que le classeur se rempli, la macro d'enregistrement devient de plus en plus lente. J'ai essaié de mettre la partie With WsDc.Range("a2:i65536") dans le classeur Base évenement workbook.sheets_change, mais n'arrivant pas à faire l'appel du userform à partir de "Base", j'ai laissé tomber.

 

[Bebere]

Lone-wolf dans usfvisualise ce sont les dates qui posent problème
dans sorties tu remplaces les . par / avec rechercher
tu auras une date sous cette forme 08-08-16(c'est lié avec les paramètres dates de windows)
pour entrées
For i = 1 To UBound(tablo)
data(tablo(i, 1)) = tablo(i, 1) 'Format(tablo(i, 1), "dd.mm.yyyy") 'dates
Next i
pour commandes peut être utiliser les tableaux(listobject)
je ne sais pas si tu connais

 

[Lone-wolf]

Bonsoir Bebere,

moi je suis en Suisse, et dans les paramètres windows les dates par défaut ont le point. Comme je l'ai dit avant, avec les dates antérieures à aujourd'hui, il n'y a pas de problème et j'ai fait un test sur la date du jour pour voir si c'était du texte ou une date valide la msgbox à affiché que c'était une date valide.

Pour les listobjects, pas vraiment. Comme les tableaux ne sont pas tous les mêmes , sans compter qu'il y a 26 feuilles à gerer, je suis largué.

 

[Bebere]

bonjour Lone-wolf,le forum
en tout cas içi ce n'était pas des dates,essaye de mettre la colonne en format standard pour voir si tu obtiens le n° de série d'excel(peut être aller voir du côté de application.international).Je vais essayer avec listobject dans commandes

 

[Lone-wolf]

Bonjour Bebere,

Oui c'étaient bien les dates qui causaient problème et les variables Article-Jours-Qte. Dans la macro d'enregistrement de l'usfcommandes, j'avais pas pensé à mettre la condition si ctrl est une date alors... (ligne: For each ctrl in Me.Controls) et j'ai ajouté Format(CDate(xxxx).......) pour tous les contrôles contenant une date. J'ai donc tout supprimé et recommencé des nouveaux enregistrements et changé la macro de combobox5. Apparemment, tout semble ok, pour l'instant.

 

[Lone-wolf]

Bonjour Bebere,

nouvelle MAJ des fichiers. Modifications des combobox Representants - Clients et Produits en tableaux, dans UsfCommandes et UsfModCommandes et ajout d'une macro (CA) pour les représentants et clients.

 

[Bebere]

Bonsoir Lone-wolf
si tu as envie tu peux continuer avec René,et toi quel est ton prénom
pour déclarer un tableau,onglet acceuil mettre sous forme de tableau
tu choisis la mise en forme
tu sélectionnes la plage avant,entêtes compris
voilà un exemple pour tableau

    Dim LR As ListRow, Lobj As ListObject
   
    Set Lobj = WsDC.ListObjects(1) 'détail cde
    Set LR = Lobj.ListRows.Add(AlwaysInsert:=True)
    With LR.Range
        .Cells(1, 1) = LR.Range.Row - 1
        .Cells(1, 2) = Me.TxtNC    'n° cde
        .Cells(1, 3) = Me.CmbArticles    'article
        .Cells(1, 4) = CDbl(TxtQte)
        .Cells(1, 5) = CDbl(Me.TxtPrix)
        .Cells(1, 6) = CDbl(Pourcent)
        If CmbRabais.Text = "" Then .Cells(1, 7) = 0 Else .Cells(1, 7) = CDbl(Me.CmbRabais)
        .Cells(1, 8) = CDbl(Montant)
        .Cells(1, 9) = CDate(Me.DateC)
    End With

'je pense que ce code suffit

        With WsStock
            lig = .Range("c" & Rows.Count).End(xlUp).Row
            For x = 2 To lig
                If .Range("c" & x) = Me.CmbArticles Then
                    .Range("i" & x) = WorksheetFunction.SumIf(WsDC.Range("c2:c65536"), .Range("c" & x), WsDC.Range("d2:d65536"))
                    .Range("k" & x) = .Range("e" & x) - .Range("i" & x)
                    If .Range("k" & x) <= 0 Then .Range("l" & x) = .Range("k" & x)
                    Exit For
                End If
            Next x
        End With

concerne bouton enregistrer