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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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