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 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
| Sub location()
Dim TheDate As Long, Index As Variant
Application.ScreenUpdating = False
Worksheets("Articles").Activate
Code = "LCHAP300" 'Code AGLM
Cde3 = "1" 'Command.TB3 'Valeur de la TB3 de l'USF Command
DatCde = CDate("04/01/13") 'Command.Lab_DatCde.Caption
DatRet = CDate("06/01/13") 'Command.Lab_DateRetour.Caption
'If Command.TB3 = "" Then
'Else
Worksheets("Articles").Activate
With Sheets("Articles")
'Chercher son nom dans la feuille Conso colonne B
Set C = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Find( _
What:=Code, _
After:=.Range("B2"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Columns(2).Find(Code, , , , , Previous).Select
C.Value = Code
MsgBox "Quantité commandé : " & Cde3
If C(1, 8).Value = "" Then
C(1, 8) = Cde3 'Nbre ce Chapiteaux Cdé
C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
Else
C(1, 8) = C(1, 8) + Cde3 'Qté Sortie + Cde en cours
C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
End If
If DatCde = "" Then
Else: C(1, 9) = CDate(DatCde) ' Affiche la Date de Sortie
End If
If DatRet = "" Then
Else: C(1, 10) = CDate(DatRet) ' Affiche la date Retour
End If
C(1, 11).Select
ActiveCell.FormulaR1C1 = _
"=IF([@[Date de Retour]]="""","""",[@[Date de Retour]]-[@[Date de Sortie]])" ' Nbre de Jour de Loc = Date de Sortie - Date de Retour
Temps = C(1, 11)
'Recherche Date du début
End With
TheDate = CDate(C(1, 9)) '(Command.Lab_DatCde)
With Worksheets("Articles")
ActiveSheet.Cells(2, 13).Select ' Je ne sais pas si cela est bien utile ????
Index = Application.Match(TheDate, .Range(.Cells(2, 12), .Cells(2, .Columns.Count)), 0) '
If IsError(Index) Then
MsgBox "Résultat négatif. Rien trouvé.", _
vbOKOnly + vbInformation, _
"Résultat"
Else
.Cells(2, Index).Select 'Sélectionne la date
End If
'Fin Call Croisement
'------------------Recherche la Date du Jour----------------
'---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
Set Date_Loc = ActiveCell
col = Date_Loc.Column
Set Personnel = Range("B5:B1000").Find(Command.TB_Code)
ligne = Personnel.Row
Cells(ligne, col).Select
Application.ScreenUpdating = True
For i = 1 To Temps
ActiveCell = CDec(C(1, 7))
ActiveCell.Offset(0, 1).Select
Next i
End With
Application.ScreenUpdating = True
Worksheets("Planning").Activate
'End If
End Sub |
Partager