probleme d'ajout et de suppression d'article et d'impressionRésolu

Question

bonjour à tous,
j'ai récupéré un formulaire pour suivre la gestion de stocks de marchansises et leur valeur et j'ai rencontré des difficultés surtout au niveau d'ajout et de suppression d'article et de l'impression.
je vous remercie d'avance
merci
ps : code:
 Private Sub B_FermerStock_Click()
ActiveWorkbook.Close True
End Sub
Private Sub B_Impression_Click()

   Sheets("STOCK").Select
    Cells.Select
    Selection.Copy
    Sheets("IMPRESSION").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("C:C").Select
    Selection.Cut Destination:=Columns("A:A")
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Selection.Cut Destination:=Columns("B:B")
    Columns("C:C").Select
    Selection.Cut Destination:=Columns("D:D")
    Columns("G:G").Select
    Selection.Cut Destination:=Columns("C:C")
    Columns("C:C").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    Columns("R:R").Select
    Selection.Cut Destination:=Columns("F:F")
    Columns("M:M").Select
    Selection.Cut Destination:=Columns("G:G")
    Columns("G:G").Select
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("H:AC").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("A:A").Select
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").Select
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").Select
    Columns("C:C").EntireColumn.AutoFit
    Columns("E:E").Select
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").Select
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").Select
    Columns("G:G").EntireColumn.AutoFit
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
    Cells.Select
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "ETAT DU STOCK AU &D"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&8&P/&N"
        .LeftMargin = Application.InchesToPoints(0.35)
        .RightMargin = Application.InchesToPoints(0.35)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
   
  
    
    Me.Hide
    'aperçu avant impression
    Sheets("IMPRESSION").PrintPreview
    Me.Show
    Sheets("IMPRESSION").Select
    Cells.Select
    Selection.Delete
End Sub

Private Sub B_SuppressionArticle_Click()
Dim Article As String

Article = ListView1.SelectedItem

With Sheets("STOCK")
    Dim iRow As Long
    For iRow = .Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
    If .Cells(iRow, 1).Value = Article Then
    
    
    x = MsgBox("CONFIRMEZ-VOUS LA SUPPRESSION DE CET ARTICLE DU STOCK ?", vbYesNo)
    If x = 6 Then
        .Rows(iRow).Cut
        Worksheets("ARTICLES RETIRES DU STOCK").Select
            DerLig = Sheets("ARTICLES RETIRES DU STOCK").Range("A65536").End(xlUp)(2).Row
            Range("A" & DerLig).Select
            ActiveSheet.Paste
        Worksheets("STOCK").Select
        .Rows(iRow).Select
        Selection.Delete Shift:=xlUp
    Else
    Exit Sub
    End If
        Exit For
    End If
    Next iRow
   
For i = ListView1.ListItems.Count To 1 Step -1
If ListView1.ListItems(i).Selected = True Then ListView1.ListItems.Remove i
    Next i
    
End With
End Sub

Private Sub UserForm_initialize()


With ListView1
    With .ColumnHeaders
       .Clear
       .Add , , "Référence", 100
       .Add , , "Désignation", 250
       .Add , , "Qté en stock", 70, (2) 'alignement de la col est au centre (2)
       .Add , , "Prix Vente HT", 70, (1) 'alignement de la col est à droite (1)
       .Add , , "Durée", 70, (1)
       .Add , , "Poids MA", 70, (1)
       .Add , , "Calibre", 70, (1)
       .Add , , "Type", 100, (1)
       .Add , , "Fournisseur", 100, (1)
    End With
 .Gridlines = True
  For i = 3 To Sheets("STOCK").Range("A65536").End(xlUp).Row
.ListItems.Add , , Sheets("STOCK").Cells(i, 1) 'référence
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 3) 'désignation
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 16) 'qté en stock
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("STOCK").Cells(i, 11), "## ##0.00 €") 'PVHT
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 6) 'durée
.ListItems(.ListItems.Count).ListSubItems.Add , , Format(Sheets("STOCK").Cells(i, 7), "# ##0.000") 'poids MA
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 5) 'calibre
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 4) 'type
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("STOCK").Cells(i, 2) 'fournisseur
  If Sheets("STOCK").Cells(i, 16) > 0 Then
    .ListItems(.ListItems.Count).ListSubItems(2).ForeColor = &H4040
     Else
    .ListItems(.ListItems.Count).ListSubItems(2).ForeColor = &HFF
    .ListItems(.ListItems.Count).ListSubItems(2).Bold = True
    End If: Next: End With
 

ValeurTotaleStock = Format(Sheets("STOCK").Range("Q1").Value, "## ##0.00 €")
PTMAinf500gr = Format(Sheets("STOCK").Range("I1").Value, "## ##0.000")
PTMAsup500gr = Format(Sheets("STOCK").Range("J1").Value, "## ##0.000")
PMATOTAL = Format(Sheets("STOCK").Range("R1").Value, "## ##0.000")

 
End Sub
Private Sub ListView1_Click()
'dès que l'on clique sur l'article, on affiche dans le formulaire usfDetailArticle les entrées et sorties de stock de l'article

NumArticle = ListView1.SelectedItem

Dim ShS As Worksheet
Set ShS = Worksheets("SORTIES")
Dim ShE As Worksheet
Set ShE = Worksheets("ENTREES")
Dim Article As String

Article = NumArticle

On Error Resume Next
With ShS
'définir la zone de critère
'choisir l'étiquette de la colonne A1 -> champ où exploiter le filtre
.Range("K1") = .Range("A1")
.Range("K2") = Article 'la valeur du critère du filtre
ShS.Range("P1").CurrentRegion.Clear

'Définir la plage de cellules pour le filtre...
With .Range("A1:F" & .Range("A65536").End(xlUp).Row)
'Application du filtre
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ShS.Range("K1:K2"), _
CopyToRange:=ShS.Range("P1"), Unique:=False
'Copie vers la cellule où débutera la plage résultat
End With
.ShowAllData
End With

With ShE
'définir la zone de critère
'choisir l'étiquette de la colonne A1 -> champ où exploiter le filtre
.Range("K1") = .Range("A1")
.Range("K2") = Article 'la valeur du critère du filtre
ShE.Range("P1").CurrentRegion.Clear

'Définir la plage de cellules pour le filtre...
With .Range("A1:F" & .Range("A65536").End(xlUp).Row)
'Application du filtre
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ShE.Range("K1:K2"), _
CopyToRange:=ShE.Range("P1"), Unique:=False
'Copie vers la cellule où débutera la plage résultat
End With
.ShowAllData


NumArticle = ShS.Range("K2").Value
    With Sheets("STOCK").Range("A:A")
    Set C = .Find(NumArticle, LookIn:=xlValues, lookat:=xlWhole)
    If Not C Is Nothing Then Lig = C.Row
    End With
End With
Me.Hide
Unload UsfDetailArticle
UsfDetailArticle.Show
End Sub
Private Sub B_NouvelArticle_Click()
Me.Hide
Unload UsfNouvelArticle
UsfNouvelArticle.Show
End Sub
Private Sub B_GoFour_click()
Me.Hide
UsfStockFournisseur.Show
End Sub
Private Sub B_GoType_click()
Me.Hide
UsfStockType.Show
End Sub
Private Sub B_GoCalibre_click()
Me.Hide
UsfStockCalibre.Show
End Sub

Private Sub Userform_QueryClose(Cancel As Integer, CloseMode As Integer)


Cancel CloseMode vbFormControlMenu
End Sub

cs_rt15 · Accepted Answer

Bonjour,

Pour une question VBA, merci de poster sur vbfrance dans le thème VBA.

[ Déplacé sur vbfrance ]

Probleme d'ajout et de suppression d'article et d'impression

1 réponse

Votre réponse

Discussions similaires