Enchainement de procédures
Bonjour le forum,
je reviens avec mon problème de déploiement de plan :
je clique sur une date, je réalise deux recherches sur une autre feuille pour pointer sur l'élèment intéressant et j'ouvre le plan à ce niveau.
Ca fonctionne sur un classeur avec la même structure mais pas sur le fichier de production !
Arrivant sur la ligne :
Code:
Range("A1:A2199").Rows(1883).ShowDetail = True
le programme lance une fonction indépendante non présente sur la feuille active (ongletName) contenant le plan mais présente sur la feuille que j'ai quitté (celle sur laquelle j'ai cliqué)
Voici le code de la procédure utilisée (avec divers tests):
Code:
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
| Sub PointeSurOP(TargetCalendrier As Range)
Dim OngletName As String
Dim DernLign As Long
Dim NomEmploi As String
Dim DateOp As Date
Dim RgEmploi As Range
Dim RgDate As Range
Dim cEmploi As Variant
Dim ccDate As Variant
'--- Récupère les paramètres de recherche
NomEmploi = Cells(TargetCalendrier.Row, 2) 'Sur la même ligne mais en colonne 2 (B)
DateOp = Format(TargetCalendrier.Value, "Short Date") 'TargetCalendrier.Value
'--- Récupère les
OngletName = "OP" & Trim$(Str$(Year(Range("B3"))) & "-" & Trim$(Str$(Year(Range("B3"))) + 1))
DernLign = Worksheets(OngletName).Range("A65500").End(xlUp).Row
'Pointe sur la première cellule pour lancer la cellule
Worksheets(OngletName).Activate
Set RgEmploi = Worksheets(OngletName).Range("A1:A" & DernLign)
With RgEmploi
Set cEmploi = .Find(What:=NomEmploi, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
If Not cEmploi Is Nothing Then
'TargetCalendrier trouvé"
'Affiche la sous-arborescence niveau 2
Worksheets(OngletName).Activate
ActiveSheet.Range("A91").Select
Range("A1:A2199").Rows(.Emploi.row).EntireRow.ShowDetail = True
'Puisque la date intéressante est placée en dessous du premier nom correspondant entré
'il suffit de chercher dans cette plage la première date correspondante
Set RgDate = Worksheets(OngletName).Range("B" & cEmploi.Row & ":I" & DernLign)
'Worksheets(OngletName).Activate
'ActiveSheet.Range("B" & cEmploi.Row & ":I" & DernLign).Select
'MsgBox "zone selectionnee"
With RgDate
Set ccDate = .Find(What:=CDate(DateOp), LookIn:=xlFormulas) 'Format(DateOp, "jj-mmm")) ', LookIn:=xlValues)
If Not ccDate Is Nothing Then
'Affiche l'arborescence
Worksheets(OngletName).Activate
Range("A1:D9000").Rows(ccDate.Row).ShowDetail = True
Else
MsgBox "Pas trouvé la date" & DateOp & "dans la base", vbOK + vbCritical, "Erreur de redirection"
End If
End With
Else
MsgBox NomEmploi & " non trouvé"
End If
End With
'---
Set RgEmploi = Nothing
Set RgDate = Nothing
Set cEmploi = Nothing
Set ccDate = Nothing
End Sub |
Voici le code d'appel :
Code:
1
2
3
4
5
6
7
8
9
| Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'--- Pour éviter d'ouvrir la cellule pour l'éditer
Cancel = True
'--- Double-Clic sur une date du calendrier ?
If Not Intersect(Target, Union(Range("C5:T15"), Range("C19:T19"), Range("C31:T41"))) Is Nothing Then
Call PointeSurOP(Target)
End If
End Sub |
Pourquoi je reviens sur la feuille précédente et refait la mise à jour ?
ESVBA
