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

Lone-wolf

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Les Milles Merveilles.zip
    1.8 MB · Affichages: 146

Lone-wolf

XLDnaute Barbatruc
Bonjour Bebere,

je viens de faire un copier-coller de tous les codes de UsfStock dans mon dernier fichier et j'ai ce message d'erreur
erreur.gif


Tu voudrais bien faire un test sur mon dernier fichier? Sur celui que tu as mis, je n'ai pas d'erreur.
 

Pièces jointes

  • Les Milles Merveilles.zip
    1.8 MB · Affichages: 121

ChTi160

XLDnaute Barbatruc
Bonjour Lone-Wolf
Bonjour Le Fil , Le Forum

je suis ce fil , ne pourrais tu nous dire a quel moment de l'utilisation de Ton projet , tu as l' affichage de ce Message
moi je n'ai encore rien trouvé Lol , lors de mes essais .
Bonne Journée
Amicalement
Jean Marie
 

Lone-wolf

XLDnaute Barbatruc
Bien le bonjour Jean Marie :)

C'est lorsque je fais un changement avec la combobox fournisseurs. Et là je ne comprends pas pourquoi toi tu n'as pas d'erreur vus qu'on as la même version Excel. Pourrais-tu faire un test sur ce fichier?
 

Pièces jointes

  • Les Milles Merveilles.zip
    1.8 MB · Affichages: 129

Lone-wolf

XLDnaute Barbatruc
Re Jean Marie,

Je ne pense pas, à moin que...

VB:
Option Explicit

Private Declare PtrSafe Function FindWindowA& Lib "User32" _
    (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare PtrSafe Function EnableWindow& Lib "User32" _
    (ByVal hWnd&, ByVal bEnable&)
Private Declare PtrSafe Function GetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&)
Private Declare PtrSafe Function SetWindowLongA& Lib "User32" _
    (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
   
Dim NArt As Variant, CArt As Variant, Cat As Variant, Csk As Variant, _
CatSk As Variant, Ask As Variant, Ncm As Variant
  
Dim Prix#, Tva#, Frais#, Montant#, Total#, Prc@, Tva2&, Num&, LNom, LPrenom

Private Sub UserForm_Initialize()
Dim i%, k%

Me.Caption = "CONTRÔLES STOCK - LES MILLES MERVEILLES"
Call Init_Feuilles

tbl = WsProd.Range("A2:N" & WsProd.Range("d65536").End(xlUp).Row)
    Num = WsBons.Range("z1").Value

    Set d = New Dictionary
    For i = 1 To UBound(tbl)
        d(tbl(i, 5)) = tbl(i, 5)    'fournisseur
    Next i
    CmbFrn.List = d.ItemS

    Set d = New Dictionary
    For i = 1 To UBound(tbl)
        d(tbl(i, 4)) = tbl(i, 4)    'catégorie
    Next i
    CmbCat.List = d.ItemS

ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "65;140"

    Dim x As Long, Fichier As String
    Fichier = ThisWorkbook.Path & "\tresor.ico"
    x = Len(Dir(Fichier))
    If x = 0 Then Exit Sub
    x = ExtractIconA(0, Fichier, 0)
    SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, x
   
    Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
End Sub

Private Sub UserForm_Activate()
ListBox1.Clear
CmbCat = ""
CmbFrn = ""
TxtAchat = ""
TxtVente = ""
Label1.Caption = "Code article"
Label2.Visible = True

TxTResp = WsRep.Range("b3")
TxtDate = Format(Date, "dd.mm.yyyy")

Dim hWnd As Long
    hWnd = FindWindowA("XLMAIN", Application.Caption)
    EnableWindow hWnd, 1
End Sub

Private Sub CmbCat_Change()
  Dim i As Long
    If Me.CmbCat <> "" Then
        Me.ListBox1.Clear
        For i = LBound(Lignes) To UBound(Lignes)
            If tbl(Lignes(i), 5) = Me.CmbFrn And tbl(Lignes(i), 4) = Me.CmbCat Then
                Me.ListBox1.AddItem
                Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = tbl(Lignes(i), 2)
                Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = tbl(Lignes(i), 3)
            End If
        Next

    End If
End Sub

Private Sub CmbFrn_Change()
Dim i As Long, d As New Dictionary, Ctrl As Control

    If Me.CmbFrn <> "" Then
        Me.CmbCat = ""
        Me.ListBox1.Clear

        For Each Ctrl In Me.Controls
            If TypeOf Ctrl Is MSForms.TextBox Then Ctrl = ""
        Next
       
       ListeFournCat Me.CmbFrn    'module1
        For i = LBound(Lignes) To UBound(Lignes)
            If tbl(Lignes(i), 5) = Me.CmbFrn Then d(tbl(Lignes(i), 4)) = tbl(Lignes(i), 4)
        Next
        Me.CmbCat.List = d.ItemS
    End If
End Sub

Private Sub ListBox1_Click()
Dim rw&, k&, j&, nb&, i As Long

    If CmbFrn <> "" And CmbCat <> "" Then

        For i = LBound(Lignes) To UBound(Lignes)
            If tbl(Lignes(i), 2) = ListBox1.List(ListBox1.ListIndex, 0) Then
                rw = Lignes(i) + 1: Exit For
            End If
        Next
        Me.TxtEntree = WsStock.Cells(rw, 13)
        Me.TxtSortie = WsStock.Cells(rw, 9)
        For j = 2 To 12
            Controls("TextBox" & j) = WsStock.Cells(rw, j)
        Next j
    End If

    If Me.TxtEntree.Value = 0 Then Me.TxtEntree = ""
    If Me.TxtSortie.Value = 0 Then Me.TxtSortie = ""

    TxtAchat = Format(tbl(Lignes(i), 6), "0.00")
    TxtVente = Format(tbl(Lignes(i), 7), "0.00")

End Sub

Private Sub CmdNouveau_Click()
Dim lig%, i As Byte

If CmbCat <> "" Then
With WsStock
lig = .Range("b65536").End(xlUp).Row + 1
.Cells(lig, 1) = lg - 1
For i = 2 To 13
.Cells(lig, i) = Controls("TextBox" & i)
Next i
End With
Else
Exit Sub
End If

If CmbFrn <> "" Then
With WsStock
lig = .Range("b65536").End(xlUp).Row + 1
.Cells(lig, 1) = lig - 1
For i = 2 To 13
.Cells(lig, i) = Controls("TextBox" & i)
Next i
End With
Else
Exit Sub
End If

For i = 2 To 13
Controls("TextBox" & i) = ""
Next i
TxtEntrees = ""
TxtSorties = ""
TxtAchat = ""
TxtVente = ""

End Sub

Private Sub CmdModifier_Click()
Dim i As Byte

With WsStock
Ask = Application.Match(TextBox3, .Columns(3), 0)
For i = 2 To 13
.Cells(Ask, i) = Controls("TextBox" & i)
If IsNumeric(Controls("TextBox" & i)) Then .Cells(Ask, i) = Format(Controls("TextBox" & i), "0")
Next i
End With
CmbCat = ""
CmbFrn = ""
For i = 2 To 13
Controls("TextBox" & i) = ""
Next i
TxtEntrees = ""
TxtSorties = ""
TxtAchat = ""
TxtVente = ""
End Sub

Private Sub CmdSupprimer_Click()
With WsStock
    Ask = Application.Match(TextBox3, .Columns(3), 0)
    .Rows(Ask).EntireRow.Delete
End With
End Sub

Private Sub CmdSupTous_Click()
Dim derlig&, lig&, k&, x&

With WsStock
derlig = .Cells(65536, 4).End(xlUp).Row
For x = derlig To 2 Step -1
If .Cells(x, 4) = CmbCat.Value Then .Cells(x, 4).Delete shift:=xlUp
Next x
lig = .Range("a65536").End(xlUp).Row
For k = 2 To lig
If .Cells(k, 2) <> "" Then .Cells(k, 1) = k - 1
Next k
End With
End Sub

Private Sub CmdAchats_Click()
Dim cel As Range, rw&, x%, premaddress, NomRes
Dim lig%, rech&, i As Byte, Nt&, Rpt$

Total = TxtAchat * TextBox13
Num = WsBons.Range("z1").Value

With WsFn
LPrenom = .Cells(Frs, 18)
LNom = .Cells(Frs, 19)
End With

With WsAchats
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1) = lig - 1
.Cells(lig, 2) = "BC - " & LPrenom & LNom & " " & Num
.Cells(lig, 3) = CmbFrn
.Cells(lig, 4) = TextBox2
.Cells(lig, 5) = TextBox3
.Cells(lig, 6) = TextBox4
.Cells(lig, 7) = Format(TextBox13, "0")
.Cells(lig, 8) = Format(TxtAchat, "0.00")
.Cells(lig, 9) = Format(Total, "0.00")
End With

On Error Resume Next
With WsBons
Set cel = WsAchats.Range("c2:c65536").Find(CmbFrn, , xlValues)
x = 17
If Not cel Is Nothing Then
premaddress = cel.Address
Do
x = x + 1
.Range("b" & x).Value = cel.Offset(0, 1).Value  'Code Article
.Range("c" & x).Value = cel.Offset(0, 2).Value  'Designation
.Range("d" & x).Value = cel.Offset(0, 4).Value  'Quantité
.Range("e" & x).Value = Format(cel.Offset(0, 5).Value, "0.00")  'Prix
.Range("f" & x) = Format(cel.Offset(0, 6).Value, "0.00")

Set cel = WsAchats.Range("c2:c65536").FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> premaddress
End If

.Range("f2") = "BC - " & LPrenom & LNom & " " & Num
.Range("f4") = Format(TxtDate, "dd.mm.yyyy")
.Range("f6") = CmbFrn
.Range("f7") = WsFn.Cells(Frs, 3) & " " & WsFn.Cells(Frs, 4)
.Range("f8") = WsFn.Cells(Frs, 6)
.Range("f9") = WsFn.Cells(Frs, 7) & " " & WsFn.Cells(Frs, 8)

Rpt = Application.Match(TxTResp, WsRep.Columns(2), 0)

NomRes = WsRep.Cells(Rpt, 5)
Nt = WsFn.Cells(Frs, 15)

Prix = WorksheetFunction.Sum(WsBons.Range("f18:f40"))
Prc = Val(Nt) / 100
Tva = Round(Prix * Prc, 1)
Frais = WsFn.Cells(Frs, 16)
Montant = Prix + Tva + Frais

.Range("b10") = WsC.Range("x1").Value & "  " & WsRep.Cells(Rpt, 9)
.Range("b11") = WsC.Range("y1").Value & " " & WsRep.Cells(Rpt, 11)
.Range("f11") = TxTResp
.Range("f12") = NomRes
.Range("f45") = Prix
.Range("e46") = "Tva " & Nt & "%"
.Range("f46") = Tva
.Range("f47") = Frais
.Range("f49") = Montant
End With


Ask = Application.Match(TextBox3, WsStock.Columns(3), 0)
WsStock.Cells(Ask, 13) = Format(TextBox13, "0")

WsBons.Range("f18:f40") = Format(WsBons.Range("f18:f40"), "0.00.-")
WsBons.Range("f45") = Format(Prix, "0.00.-")
WsBons.Range("f46") = Format(Tva, "0.00.-")
WsBons.Range("f47") = Format(Frais, "0.00.-")
WsBons.Range("f49") = Format(Montant, "0.00.-")


For i = 2 To 13
Controls("TextBox" & i) = ""
Next i
TxtAchat = ""
TxtVente = ""
TxtEntrees = ""
TxtSorties = ""
End Sub

Private Sub TextBox3_Change()
    If Me.TextBox3 <> "" Then
        NArt = Application.Match(TextBox3, WsProd.Columns(3), 0)
        Me.Label23 = NArt
    End If
End Sub

Private Sub LblES_Click()
Unload Me
UsfVisualise.Show
End Sub

Private Sub LbBC_Click()
Num = WsBons.Range("z1").Value
Num = Num + 1
WsBons.Range("z1") = Num
Unload Me
Application.WindowState = xlNormal
'WsBC.PageSetup.PrintArea = "$A$1:$H49"
WsBons.Visible = True
WsBons.PrintPreview
Application.WindowState = xlMinimized
UsfStock.Show
TxtAchat = ""
TxtVente = ""
End Sub

Private Sub CmdQuitter_Click()
Unload Me
UsfAccueil.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
 

Lone-wolf

XLDnaute Barbatruc
Re Bebere
tu parle de ligne(), mais dans la combo c'est tbl(Lignes(i) . Je suis actuellement sur le portable de mon épouse et toujours cette erreur. :mad: Pourtant j'ai mis en entête de module Lignes(), ensuite Lignes et toujours le même problème. Ce qui me rend perplexe, c'est que Jean Marie n'as pas cette erreur (Excel 2010). Moi je pense qu'il manque l'initialisation de Lignes(), Lignes = à ????? À moins de dire une connerie.
 
Dernière édition:

Bebere

XLDnaute Barbatruc
bonjour Lone-wolf,Jean Marie,le forum
le code des 2 combobox + listbox1+module1 est remanié
ajout d'une fonction qui teste si lignes est vide,tu auras un message
ce doit être le problème
 

Pièces jointes

  • Les Milles Merveilles040916.zip
    7.1 MB · Affichages: 70

Lone-wolf

XLDnaute Barbatruc
Bonjour Bebere :)

Et bien moi j'ai du nouveau, En PJ. J'ai créer un nouveau userform pour la gestion des retours(UsfRetours). J'aimerais ceci:
sélectionner le numéro de commande, la listeview affiche le détailet et j'inscrit les données dans la feuille Retours (ça c'est ok) .

Je clique sur l'une des lignes, je supprime la ligne exacte dans la feuille Détails commandes et dans la feuille Sauvegarde, et ensuite dans la feuille stock les colonnes ventes et stock réel doivent se mettre à jour, là j'ai un petit problème ;).

Edit: je ne suis pas sûr, mais les colonnes des tableaux sont à modifier ainsi que dans les macros(Redim); j'ai fait un copier-coller de toutes les macros du formulaire et j'ai toujours le même problème. Ceci parce-que tu travail toujours avec l'ancien fichier.
 

Pièces jointes

  • Les Milles Merveilles.zip
    1.9 MB · Affichages: 67
Dernière édition:

Bebere

XLDnaute Barbatruc
Lone-wolf
teste cette version,içi c'est bon
à l'ouverture j'ai eu des ennuis avec chemin,fichier,etc
fait le code autrement
changer le code dans thisworkbook et mis chemin fichier ds le module variable public
demain je regarde pour ta demande
 

Pièces jointes

  • Les Milles Merveilles070916-27.zip
    1.9 MB · Affichages: 41

Lone-wolf

XLDnaute Barbatruc
Re Bebere,

pour ma demande au post #28, concernat UsfRetours, c'est ok. Peut-être améliorer la macro du bouton Actualiser???

Et encore une demande, j'ai cettre macro dans un formulaire. Comme il y a une boucle pour les colonnes. Comment aligner le texte à droite pour les champs numériques et date??

VB:
Private Sub UserForm_Initialize()
Dim cel As Range, nbcol%, i%

Me.Caption = "INVENTAIRE - LES MILLES MERVEILLES"

Call Init_Feuilles

Set cel = WsStock.[A1]
nbcol = 15

With Me.ListView1
For i = 1 To nbcol
.ColumnHeaders.Add , , cel.Offset(0, i - 1), Width:=cel.Offset(0, i - 1).Columns.Width
Next i
Set cel = WsStock.[A2]
Do Until IsEmpty(cel)
.ListItems.Add , , cel
For i = 1 To nbcol
.ListItems(cel.Row - 1).ListSubItems.Add , , cel.Offset(0, i)
Next i
Set cel = cel.Offset(1, 0)
Loop
.FullRowSelect = True
.MultiSelect = True
.View = lvwReport
End With
End Sub
 

Pièces jointes

  • Les Milles Merveilles.zip
    1.9 MB · Affichages: 65
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla