1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
| Sub Fournitures()
Dim wshFrn As Worksheet, loFrn As ListObject, rFiltr As Range, r As Range
Dim wshChn As Worksheet, kR As Long
Set wshFrn = ThisWorkbook.Worksheets("BaseFournitures")
Set wshChn = ThisWorkbook.Worksheets("SuiviChantier")
Set loFrn = wshFrn.ListObjects("BaseFrn")
wshFrn.Select
'--- filtre sur quantité > 0
wshFrn.ListObjects("BaseFrn").Range.AutoFilter Field:=4, Criteria1:=">0", Operator:=xlAnd
Set rFiltr = loFrn.DataBodyRange.SpecialCells(xlCellTypeVisible)
'--- vérifications préalables
If rFiltr Is Nothing Then
MsgBox "Annulé: aucune quantité indiquée !", , "Annulé"
Exit Sub '--- EXIT ---
End If
If rFiltr.Rows.Count > 29 Then
MsgBox "Annulé: la feuille SuiviChantier ne peut contenir que 29 fournitures" & vbLf & _
"et vous en avez indiqué " & rFiltr.Rows.Count, , "Annulé"
Exit Sub '--- EXIT ---
End If
If MsgBox("Reprendre ces fournitures ?", vbYesNo, "Vérifier avant de copier !") = vbNo Then
wshFrn.ListObjects("BaseFrn").Range.AutoFilter
Exit Sub '--- EXIT ---
End If
If wshChn.Range("G9") <> "" Then
If MsgBox("Supprimer ce qui se trouve déjà dans SuiviChantier?", vbYesNo, "A confirmer") = vbNo Then
Exit Sub '--- EXIT ---
End If
End If
'--- report quantités de BaseFournitures à SuiviChantier
kR = 9
With wshChn
.Range("G9:J37").ClearContents '--- G9:J37 = plage des fournitures
'Debug.Print rFiltr.Address
For Each r In rFiltr.Rows
'Debug.Print r.Address
.Range("G" & kR) = loFrn.Range(r.Row, 2) '--- désignation
.Range("H" & kR) = loFrn.Range(r.Row, 4) '--- quantité
.Range("I" & kR) = loFrn.Range(r.Row, 5) '--- prix unité
.Range("J" & kR).FormulaR1C1 = "=RC[-2]*RC[-1]" '--- formule calcul
kR = kR + 1
Next r
.Range("J38").FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)" '--- formule calcul total
End With
End Sub |
Création de devis à partir d'une base de Fourniture
Répondre avec citation
Partager