Impossible de réactiver un classeur

Version imprimable

19/05/2024, 13h48
the_qd

Impossible de réactiver un classeur

Bonjour,

En résumé, dans mon classeur 1, j'ai un code qui ouvre le classeur2 si pas ouvert et recherche une valeur que je donne dans le classeur 1.
A la toute fin de ma fonction, je réactive le classeur 1.
Mon problème est que lorsque mon classeur 2 est fermé, l'activation du classeur 1 ne fonctionne pas, elle fonctionne uniquement si le classeur 2 est déjà ouvert.

De quoi est-ce que ça peut provenir ?

En vous remerciant
19/05/2024, 15h25
deedolith

Salut,

Ma question est:
Pourquoi as-tu besoin d'activer un classeur pour le manipuler ? Ca ne devrait pas être le cas.
Recupère une référence vers le classeur 2, et tu n'auras plus besoin d'activer ce dernier.
19/05/2024, 15h42
the_qd

Justement, je voudrais que le classeur 1 reste activé mais comme le classeur 2 s'ouvre s'il est fermé, le classeur 1 perd le focus donc j'aimerais lui redonner
A moins qu'il existe une méthode pour ne pas ouvrir le classeur 2 que je ne connais pas

Pour cela, il te faut au préalable instancier une nouvelle application excel.
Cette dernière étant invisible par défaut, tu pourras y ouvrir un classeur sans "perturber" l'affichage du premier.

Par exemple:
Code:

1 2 3 4 5 6 7 8 Public Function OpenWorkbook(ByVal Path As String) As Excel.Workbook Dim App As Excel.Application Set App = New Excel.Application Dim Wb As Excel.Workbook Set Wb = App.Workbooks.Add(Path) Set OpenWorkbook = Wb End Function
La manipulation du classeur ouvert se fait via la référence retournée.

19/05/2024, 20h12
the_qd

Je vais essayé cette solution.
Par contre, est-ce que tu sais pour quelle raison, l'activate ne fonctionne que si le classeur 2 est déjà ouvert et pas si on doit l'ouvrir depuis le classeur 1 ?
20/05/2024, 02h17
deedolith

Voyons que dit ma boule de cristal ...
Ha rien, elle est est cassée.

Sans ton code originel, pas moyen de répondre.

Voilà la procédure avec l'activate qui fonctionne si "Post-calculation.xlsx" est déjà ouvert et plus si on doit l'ouvrir
J'ai controlé avec le debug.print et c'est bien Planning.xlsm qui est activé après "Workbooks("Planning.xlsm").Worksheets("Recherche").Activate"

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
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
 
Option Explicit
Sub ListerValeurFichiersMultiples()
Dim Cible As String, Chemin As String, nb As Integer
Dim firstAddress As String, Cell As Range, Tableau(), Tableau2(), j As Integer, k As Integer, x As Integer, y As Integer, nb_tableau As Integer
Dim nb_sheets As Integer, i As Integer, der_ligne As Integer
Dim plage_recherche, chemin_et_fichier, fichier As String
 
 
'Désactivation de l'affichage
Application.ScreenUpdating = False
'Dernière ligne de la page
der_ligne = Range("B" & Rows.Count).End(xlUp).Row
'Effacement des résultats précédents
Worksheets("Recherche").Range("A2:H" & der_ligne).ClearContents
'Valeur à recherhcer dans les classeurs Excel du même répertoire
Cible = Worksheets("Recherche").valeur.Value
 
' Contrôle d'une saisie de valeur
If Cible = "" Then Exit Sub
Debug.Print ActiveWorkbook.Name
'//-- Recherche dans le fichier post-calculation en premier
'Si le fichier Post-calculation n'est pas ouvert, on l'ouvre
fichier = "Post-calculation.xlsx"
chemin_et_fichier = ThisWorkbook.Path & "\" & fichier
If Test_EstOuvert(chemin_et_fichier) = False Then
    Workbooks.Open chemin_et_fichier
End If
 
'Affiche toutes les données (supprime les filtres)
On Error Resume Next
Workbooks(fichier).Worksheets("Post-calculation").ShowAllData
 
der_ligne = Workbooks(fichier).Worksheets("Post-calculation").Range("F" & Rows.Count).End(xlUp).Row 'Dernière ligne de la feuille post-calculation
plage_recherche = "F6:E" & der_ligne
 
With Workbooks(fichier).Worksheets("Post-calculation").Range(plage_recherche).Cells
    Set Cell = .Find(Cible, LookIn:=xlValues, lookat:=xlPart)
    'Mise en mémoire des résultats dans un tableau
    If Not Cell Is Nothing Then
        firstAddress = Cell.Address
        Do
        'Mise en tableau des adresses des valeurs trouvées
            x = x + 1
            ReDim Preserve Tableau(7, x)
            Tableau(1, x) = Cell.Address 'coordonnées de la cellule
            Tableau(2, x) = Cell.Value 'N° de l'article
            Tableau(3, x) = "Post-calculation" 'nom de la feuille"
            Tableau(4, x) = Cell.Offset(0, 3).Value 'N° commande
            Tableau(5, x) = Cell.Offset(0, -2).Value 'date livraison
            Tableau(6, x) = Cell.Offset(0, 6).Value 'nombre d'article
            Tableau(7, x) = Cell.Offset(0, 8).Value 'prix unitaire
 
            Set Cell = .FindNext(After:=Cell)
        Loop While Not Cell Is Nothing And Cell.Address <> firstAddress
    End If
 End With
'--//
Debug.Print ActiveWorkbook.Name
Workbooks("Planning.xlsm").Worksheets("Recherche").Activate
 
Debug.Print ActiveWorkbook.Name
'//-- Recherche dans les feuilles d'année
nb_sheets = Sheets.Count
' Boucle sur les feuilles du classeur
For i = 1 To nb_sheets
    If IsNumeric(Worksheets(i).Name) Then ' Vérification que la feuille est bien une année
 
        'Affiche toutes les données (supprime les filtres)
        On Error Resume Next
        Worksheets(i).ShowAllData
 
        der_ligne = Worksheets(i).Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne de la feuille en cours
        If (Worksheets(i).Name > 2023) Then 'Si le planning est depuis 2024, on change la plage de recherche (modif de la mise en page)
            plage_recherche = "E6:E" & der_ligne
        Else
            plage_recherche = "D12:E" & der_ligne
        End If
 
        With Worksheets(i).Range(plage_recherche).Cells
            Set Cell = .Find(Cible, LookIn:=xlValues, lookat:=xlPart)
            'Mise en mémoire des résultats dans un tableau
            If Not Cell Is Nothing Then
            firstAddress = Cell.Address
            Do
                'Mise en tableau des adresses des valeurs trouvées
                y = y + 1
                ReDim Preserve Tableau2(7, y)
                Tableau2(1, y) = Cell.Address 'coordonnées de la cellule
                Tableau2(2, y) = Cell.Value 'N° de l'article
                Tableau2(3, y) = Worksheets(i).Name 'nom de la feuille
                Tableau2(4, y) = Cell.Offset(0, 3).Value 'N° commande
                Tableau2(5, y) = Cell.Offset(0, -2).Value 'date livraison
                If (Worksheets(i).Name > 2023) Then 'Si le planning est depuis 2024, on change la plage de recherche (modif de la mise en page)
                    nb = Cell.Offset(0, 6).Value
                    Tableau2(6, y) = nb 'nombre d'article
                    Tableau2(7, y) = Cell.Offset(0, 7).Value / nb 'prix unitaire
                Else
                    nb = Cell.Offset(0, 4).Value
                    Tableau2(6, y) = nb 'nombre d'article
                    Tableau2(7, y) = Cell.Offset(0, 5).Value / nb 'prix unitaire
                End If
                 Set Cell = .FindNext(After:=Cell)
             Loop While Not Cell Is Nothing And Cell.Address <> firstAddress
             End If
         End With
    End If
Next i
'//--
Debug.Print ActiveWorkbook.Name
'Affichage des résultats
If x <> 0 Then ' Si le tableau post-calculation n'est pas vide
    With Worksheets("Recherche")
    For j = 1 To x
        For k = 0 To 7
        .Cells(j + 1, k + 1) = Tableau(k, j)
        Next k
    Next j
    End With
End If
 
If y <> 0 Then ' Si le tableau des feuille d'années n'est pas vide
    With Worksheets("Recherche")
    For j = 1 To y
        For k = 0 To 7
        .Cells(j + x + 1, k + 1) = Tableau2(k, j)
        Next k
    Next j
    End With
End If
Debug.Print ActiveWorkbook.Name
Range("B1").Value = "Cellule"
Range("C1").Value = "N° article"
Range("D1").Value = "Année"
Range("E1").Value = "Commande"
Range("F1").Value = "Date livraison"
Range("G1").Value = "Nombre"
Range("H1").Value = "Prix unitaire"
Range("I1").Value = "Double-cliquer sur l'adresse de la cellule pour afficher la ligne"
 
End Sub

Concernant l'activation:
Sauf besoin de montrer quelque chose de particulier à l'utilisateur,
tu n'as pas besoin d'activer quoi que ce soit, il suffit de référencer un classeur, une feuille, une plage ou tout autre objet Excel pour pouvoir interagir avec.

Pour être sûr que cela fonctionne à 100%, encore faut-il contextualiser précisément les références, ce que tu ne fait pas (la faute aux tutoriels foireux qui pullulent sur internet).
Excel introduit un contexte implicite, qui certes, facilite les chose, mais est surtout source d'erreurs.
En effet, ce dernier est extrêmement dépendant des actions utilisateurs, et de la sélection courante (en d'autre termes, il est susceptible dans changer n'importe quand).
En informatique, on aime pas ce genre de comportement, qui, par définition est incontrôlable et imprévisible.
Les objets affectés par ce contexte sont entre autre les collections:
Worksheets, Range, Cells (sans specifier l'objet parent), qui implicitement font référence à:
Application.ActiveWorkbook.Worksheets, Application.ActiveWorkbook.ActiveSheet.Range, Application.ActiveWorkbook.ActiveSheet.Cells.

Pour remédier à cela, et être sûr à 100% de quoi on parle, on préfèrera utiliser des références explicites, avec déclaration et initialisation de variables en bon et due forme.
Mention spéciale:
La fonction ThisWorkbook renvoie une référence vers le classeur qui contient le code (à ne pas confondre avec le classeur actif).
Exemple:
Code:

1 2 Dim Ws As Excel.Worksheet Set Ws = ThisWorkbook.Worksheets("Recherche") '// Reference explicite vers la feuille nommée Recherche du classeur executant le code.
Concernant ta fonction:
Avec la solution que je t'ai donné, elle ne peut plus fonctionner.
D'une part elle assume que le classeur Post-calculation.xlsx est déja ouvert dans l'application courrante, ce dont elle n'a aucune certitude, ni aucun moyen de s'en assurer.
D'autre part, la solution que je t'ai donné instancie une nouvelle application dont elle ne connait pas la référence.
Il n'y a pas 36 solutions pour y remédier:
Lui donner en argument tout ce dont elle a besoin pour effectuer son job, en l'occurence une référence vers le second classeur, voir même une référence vers la feuille Post-calculation.
C'est ce qu'on appelle respecter la Loi de Demeter (https://fr.wikipedia.org/wiki/Loi_de_D%C3%A9m%C3%A9ter).

Une version corrigée de ton code peut ressembler à quelque chose comme suit:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Option Explicit Sub ListerValeurs() Dim Wb As Excel.workbook Set Wb = OpenWorkbook("c:\......\Post-calculation.xlsx") ListerValeurFichiersMultiples Wb.Worksheets("Post-calculation") End Sub Sub ListerValeurFichiersMultiples(ByRef PostCalculs As Excel.Worksheet) '// '// Code de la fonction à ajuster '// End Sub

22/05/2024, 20h39
the_qd

Salut,

Merci pour les explications.
C'est aussi pour cette raison que je ne n'aime pas mon code car je sais qu'il n'est pas dans les règles de l'art.
Je suis novice en vba et je l'utilise très rarement et uniquement à titre personnel.

Je vais essayé ta solution mais en soit ce n'est pas bloquant donc je peux clore le sujet