Probleme d'ajout et de suppression d'article et d'impression [Résolu]

Signaler
Messages postés
1
Date d'inscription
samedi 6 mars 2010
Statut
Membre
Dernière intervention
8 mai 2010
-
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
-
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

1 réponse

Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
14
Bonjour,

Pour une question VBA, merci de poster sur vbfrance dans le thème VBA.

[ Déplacé sur vbfrance ]