Discussion :

[flo557]

Bonjour,

Je vous explique brièvement mon soucis... J'ai un classeur excel avec une feuille qui répertorie les habilitations d'un personnel, une autre des documents et j'aimerai que lorsqu'on double clic sur un intitulé de document cela nous imprime une fiche avec le nom de tout le personnel concerné. Bref je vous montre le code qui fonctionne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Columns(5)) Is Nothing Then
        Cancel = True
        Traitement Target
    End If
End Sub

Ca ça fonctionne

Ensuite

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
61
62
63
64
65
66
67
68
69
Sub Traitement(Cel As Range)
Dim Operateurs As Object
Dim Result As Range, NL As Range
Dim TabTemp As Variant, N As Variant, S As Variant
Dim Ateliers As String, Atelier As String, Statut As String
Dim L As Long, Lmax As Long
Dim C As Integer
Dim Car As Byte
    Application.ScreenUpdating = False
    'Extrait les ateliers concernés (sans séparateur)
    Ateliers = Replace(Cel.Offset(0, -3).Text, "-", "")
    With Sheets("Habilitations")
        'Mémorise le tableau des opérateurs
        C = .Range("IV2").End(xlToLeft).Column
        L = .Range("A65536").End(xlUp).Row
        TabTemp = .Range(.Cells(2, 1), .Cells(L, C))
        Set Operateurs = CreateObject("Scripting.Dictionary")
        'Pour chaque Atelier à trouver
        For Car = 1 To Len(Ateliers) Step 2
            Atelier = Mid(Ateliers, Car, 2)
                For C = 3 To UBound(TabTemp, 2)
                    If TabTemp(1, C) = Atelier Then
                        For L = 5 To UBound(TabTemp, 1)
                            If TabTemp(L, C) <> "" Then
                                '"Collecte" les statuts et noms des opérateurs (sans doublon)
                                On Error Resume Next
                                Operateurs.Add TabTemp(L, 2), TabTemp(L, 1)
                                On Error GoTo 0
                            End If
                        Next L
                        Exit For
                    End If
                Next C
        Next Car
    End With
    'MAJ résultats
    With Sheets("Edition Nom")
        .Range("A8:C65536").Delete
        Set Result = .Range("A8:B65536")
        .Cells(4, 1).Value = Cel.Text
        S = Operateurs.items
        N = Operateurs.keys
        For L = 0 To Operateurs.Count - 1
            .Cells(L + 8, 1).Value = S(L)   'Statuts
            .Cells(L + 8, 2).Value = N(L)   'Noms
        Next L
        'Tri
        Result.Sort Key1:=.Range("A8"), Order1:=xlAscending, Key2:=.Range("B8") _
            , Order2:=xlAscending
        'Mise en forme
        Lmax = .Range("B65536").End(xlUp).Row
        Set Result = .Range(.Cells(8, 1), .Cells(Lmax, 3))
        Result.Borders.LineStyle = xlContinuous
    End With
 
    Sheets("Edition Nom").Visible = True
 
' Imprime l'onglet "Edition Nom" et le supprime
    'Sheets("Edition Nom").Select
    'Application.CutCopyMode = False
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
 
' Rend invisible l'onglet "Edition Nom"
 
    'ActiveWindow.SelectedSheets.Visible = True
    'Sheets("Procédures").Select
 
 
End Sub

Ce qui me pose soucis c'est que dans ma feuille "HABILITATIONS" j'ai du rajouter des lignes au dessus des références atelier (initialement sur la ligne 2) et elles se retrouvent à la ligne 7...

TabTemp = .Range(.Cells(2, 1), .Cells(L, C))

TabTemp = .Range(.Cells(7, 1), .Cells(L, C))

Si je change le 2 par 7, plus rien ne marche... alors que j'ai simplement rajouté des lignes au dessus... Quelqu'un a une idée svp ?

Je vous remercie 1000 fois !!!

[parmi]

Bonjour,

Essaie en pas à pas pour trouver l'erreur.
Mets des points d'arrêts et vérifie tes variables et ton tableau.
Utiliser la fenêtre Espions aide beaucoup...

Sans connaître ton fichier, c'est difficile de trouver l'erreur...
Peut-être que l'erreur provient de cette ligne (?)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For C = 3 To UBound(TabTemp, 2)

[flo557]

Bonsoir,

Je vous ai mis deux fichiers Excel, l'un avec la macro qui marche et l'autre où elle ne fonctionne plus... alors que j'ai rajouté 5 lignes dans une feuille... J'ai pourtant essayé de bien tout modifier mais rien n'y fait et je me prends la tête. J'ai laissé la macro de base dans le fichier non fonctionnel... Quelqu'un peut me venir en aide svp ?

Merci !

[parmi]

2 endroits à modifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    With Sheets("Habilitations")
        'Mémorise le tableau des opérateurs
        C = .Range("IV7").End(xlToLeft).Column              '<<<<<<<<<<<<<<<<<<<<<<<<<<
        L = .Range("A65536").End(xlUp).Row
        TabTemp = .Range(.Cells(7, 1), .Cells(L, C)).Value  '<<<<<<<<<<<<<<<<<<<<<<<<<<