Discussion :

[Le Gnark]

Bonjour à tous,

Je vous expose mon problème.

J'ai réalisé un tableau excel de travail, qui se trouve en réseau local de ma boite, et qui est en partage multi-utilisateurs.
Certaine colonnes concernent particulièrement des utilisateurs (nommé pour l'exemple AAA et BBB), et l'ensemble du tableau concerne tout les autres utlisateurs.

J'ai donc créé une macro, qui permet aux utilisateurs AAA et BBB de ne pouvoir effectuer des saisies dans certaines colonnes, et aux autres de pouvoir tout modifier.
Afin d'identifier les saisies de AAA et BBB, leurs modifications apparaissent avec fond jaune et commentaire ajouté, permettant aux autres utilisateurs de les identifier d'un coup d'oeil.

Voici, avec les explications, le détail des macro ajoutées sur la feuille concernée :

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
Private Sub Worksheet_Change(ByVal Target As Range) 'appliquer une fonction en cas de changement de cellule, en fonction du nom d'utilisateur
 
If Not Intersect(Target, Range("N1:W65536, Y1:BL65536")) Is Nothing And Not (Application.UserName Like "*CCCC" Or Application.UserName Like "*DDDD") Then
'colonnes N à W et Y à BL n'étant pas modifiable par AAA et BBB, mais modifiables par les utilisateurs CCCC et DDDD
msgbox "Vous ne disposez pas de l'autorisation pour modifier cette cellule."
    Application.EnableEvents = False
    ' Efface la valeur
    Application.Undo
    Application.EnableEvents = True
End If
 
If Not Intersect(Target, Range("A1:M65536, X1:X65536")) Is Nothing And Not (Application.UserName Like "*CCCC" Or Application.UserName Like "*DDDD" ) Then
'colonnes A à M et X étant modifiable par AAA et BBB avec l'indice fond jaune et commentaire, et normale par les utilisateurs CCCC et DDDD
 If msgbox("Voulez-vous vraiment effectuer la saisie suivante :" & Chr(10) & "[ " & Target.Value & " ]" & " ?" & Chr(10) & "" & Chr(10) & "ATTENTION : La saisie précédente sera définitivement effacée.", vbYesNo) = vbYes Then
            Application.EnableEvents = False
            Target.Interior.Color = 65535 'colore le fond en jaune
 
            Target.ClearComments
            Target.AddComment
            Target.Comment.Text Text:=Target.Comment.Text & _
            Format(Target.Value) & " Modifié par : " & Environ("UserName") & _
             " Le " & Now & vbLf
            'ajoute un commentaire
 
             Target.Comment.Shape.TextFrame.AutoSize = True
                'redimmentionne le commentaire
            Application.EnableEvents = True
            Else
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            End If
End If
End Sub
 
'Bloque le double clique (colonne N à W et Y à BL)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("N1:W65536, Y1:BL65536")) Is Nothing And Not (Application.UserName Like "*CCCC" Or Application.UserName Like "*DDDD") Then
Cancel = True
End If
 
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
'Macro pour bloquer les cellules AP1 et BB1 contenant une formule de référence pour les colonnes
 
If Not Intersect(Target, Range("AQ1")) Is Nothing Then Range("AQ2").Select
If Not Intersect(Target, Range("BC1")) Is Nothing Then Range("BC2").Select
'Pour la zone de boutons macro
If Not Intersect(Target, Range("A1")) Is Nothing Then Range("G1").Select
 
 
'Pour bloquer la multi selection de cellule en fonction de l'username (AAA et BBB ne peuvent effectuer une multi sélection)
 
If Application.UserName Like Like "*CCCC" Or Application.UserName Like "*DDDD" Then
    ' Like suivi de * indique : Si le nom de l'utilisateur fini par CCCC ou DDDD
Else '= sinon
Application.CutCopyMode = False 'empêche le copie/colle
If Selection.Count > 1 Then msgbox "Les sélections multiples ne sont pas permises." & Chr(10) & "Merci de bien vouloir ne sélectionner qu'une cellule.": ActiveCell.Select
 
End If
 
End Sub

J'ai également les codes suivants dans le workbook :

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
 
Private Sub Workbook_Open()
ActiveWorkbook.Worksheets("SUIVI QUALIF ET PSA").Activate
 
If Application.CellDragAndDrop = True Then
Application.CellDragAndDrop = False 'empêche le coulissement des cellules
 
End If
 
If Application.UserName Like "CCCC" Or Application.UserName Like "*DDDD" Then
Application.CellDragAndDrop = True 'autorise le coulissement pour CCCC et DDDD
 
End If
 
End Sub
 
 
Private Sub Workbook_Desactivate()
Application.CutCopyMode = False 
If Application.CellDragAndDrop = False Then
Application.CellDragAndDrop = True
End If
End Sub

Tout cela fonctionne à merveille... sauf dans certain cas, les utilisateurs AAA et BBB ont parfois le message (cf macro msgbox) : "Vous ne disposez pas de l'autorisation pour modifier cette cellule." alors qu'il sont dans une colonne autorisée (colonne A par exemple) puis le message Message d'erreur :
Erreur d'exécution 1004 : la méthode "intersect" de l'objet _Global a échoué apparaît.
En cliquant sur "fin", ce message se ferme.
Si l'utilisateur recommence, celà fonctionne normalement pour la cellule concernée.

Ce message apparaît vraiment aléatoirement, et pas du tout systématiquement!!

Je ne comprends pas du tout pourquoi, et donc sollicite votre aide!

Celà pourrait provenir de certaines lenteur réseau ou microcoupure?