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 96 97 98 99 100 101 102 103
| Sub location()
Dim TheDate As Long, Index As Variant, Temps As Variant
Application.ScreenUpdating = False
Worksheets("Articles").Activate
DatCde = CDate(Command.Lab_DatCde)
DatRet = CDate(Command.Lab_DateRetour)
Code1 = "LCHAP000" 'Code AGLM
Code2 = "LCHAP010"
Code3 = "LCHAP300"
Code4 = "LCHAP400"
Code5 = "LCHAP500"
Code6 = "LCHAP600"
Code7 = "LCHAP330"
Code8 = "LCHAP345"
Code9 = "LCHAP360"
'Ici il faudrait que Command_TB, prenne succéssivement TB1, TB2 etc...jusqu'à 9
Cde = Command.TB 'Valeur de la TB3 de l'USF Command
If Command.TB = "" Then
Else
Worksheets("Articles").Activate
' Ici que la valeur Code Cherche Code1, puis ensuite code 2 Etc.....
With Sheets("Articles")
'Chercher son nom dans la feuille Articles 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
c(1, 12) = Cde3 'Nombre de Chapiteaux loué
If c(1, 8).Value = "" Then
c(1, 8) = Cde3 'Nbre ce Chapiteaux Cdé
c(1, 7).FormulaR1C1 = "=IF(Articles!RC7="""","""",Articles!RC7-Articles!RC9)" 'DIspo = Stock Total - Qté Sortie
Else
c(1, 8) = c(1, 8) + Cde3 'Qté Sortie + Cde en cours
c(1, 7).FormulaR1C1 = "=IF(Articles!RC7="""","""",Articles!RC7-Articles!RC9)" '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(Articles!RC11="""","""",Articles!RC11-Articles!RC10)+1" ' Nbre de Jour de Loc = Date de Sortie - Date de Retour
Temps = c(1, 11) 'Récupère la durée de Location
End With
'----------------------------------Recherche Date du début-------------------------------
TheDate = CDate(c(1, 9))
With Worksheets("Articles")
Index = Application.Match(TheDate, .Range(.Cells(1, 1), .Cells(1, .Columns.Count)), 0) '
If IsError(Index) Then
MsgBox "Résultat négatif. Rien trouvé.", _
vbOKOnly + vbInformation, _
"Résultat"
Else
.Cells(1, Index).Select 'Sélectionne la date
End If
'---------------------------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) 'ici mettre le code en cours
ligne = Personnel.Row
Cells(ligne, col).Select
For i = 1 To Temps
ActiveCell = CDec(c(1, 7)) '= Valeur du Stock
ActiveCell.Offset(0, 1).Select
Next i
If ActiveCell = "" Then
ActiveCell = c(1, 7) + c(1, 12)
Else: ActiveCell = ActiveCell + c(1, 12) ' Si la cellule est vide c'est le stock en cours + Retour
End If
End With
Application.ScreenUpdating = True
Worksheets("Planning").Activate
End If
End Sub |
Partager