Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Problème de Copier Coller avec une protection

  • Initiateur de la discussion Initiateur de la discussion cops71
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

cops71

XLDnaute Nouveau
Bonjour,

J'ai un souci concernant mon code ci-joint
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Byte
'vérification de la couleur de fond choisie
Application.ScreenUpdating = False
ActiveSheet.Unprotect
For Each Target In Range("G3:AF51")
    If Target.Interior.ColorIndex <> 36 And Target.Interior.ColorIndex <> xlNone Then
        Target.Interior.ColorIndex = xlNone
        MsgBox "La seule couleur permise est le Jaune Clair pour marquer les astreintes.", vbInformation, "Erreur de couleur de fond"
    End If
    If Target.Value = "Ind" And Target.Interior.ColorIndex = 36 Then
        MsgBox "On ne peut pas mettre une astreinte durant la semaine d'indisponibilité d'un TPA...", vbCritical, "Erreur de saisie"
        Target.Interior.ColorIndex = xlNone
    End If
Next
'calcul du nb d'astreinte mis par semaine
For i = 7 To 32
    Cells(59, i).Value = NbAstreinte(Range(Cells(3, i), Cells(51, i)))
Next
'calcul du nb d'astreinte mis par personne
For i = 3 To Range("D2").End(xlDown).Row
    Cells(i, 43).Value = NbAstreinte(Range(Cells(i, 7), Cells(i, 33)))
Next
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFiltering:=True
End Sub

Le problème est que cette feuille est censée être protégée mais si on utilise du copier, on ne peut utiliser le coller à cause de la protection remise...

Comment faire?

Merci d'avance
 
Re : Problème de Copier Coller avec une protection

Le souci c'est que cette vérification, je dois la faire au fur et à mesure...Donc si je crée une procédure dans une module, à quel moment dois je l'appeler?
 
Re : Problème de Copier Coller avec une protection

Bonsoir, la fonction "NbAstreinte", tu peux la joindre, s'il te plaît?
autrement, pas facile....

Une piste, dès l'évènement, en fonction de la cellule sélectionnée (d'ailleurs, pourquoi pas plutôt dès le changement d'une cellule...), appeler la procédure, incluant la fonction, et reprotéger la feuille ensuite..;
 
Re : Problème de Copier Coller avec une protection

Voici la fonction NbAstreinte
Code:
Function NbAstreinte(Plage As Range) As Long
'permet de calculer le nombre de cellules ayant le fond Jaune Clair(code 36) qui est la couleur choisie _
pour représenter une astreinte
Dim Cellule As Variant
Dim compteur As Long
For Each Cellule In Plage
    If Cellule.Interior.ColorIndex = 36 Then
        compteur = compteur + 1
    End If
Next
NbAstreinte = compteur
End Function

Concernant le choix de l'évenement, étant donné que je dois tester la couleur de fond, l'evenement Change ne gère que la saisie de données dans les cellules...

Mais j'attends avec impatience vos remarques et exemple de code...Je vous joins également le fichier pour que vous compreniez mieux...

Merci d'avance
 

Pièces jointes

Re : Problème de Copier Coller avec une protection

Bonjour,
je viens de tester ton fichier, et il fonctionne parfaitement....
Si tu mets la couleur jaune pâle (36) dans une cellule, le total est bon dans la ligne 59
 
Re : Problème de Copier Coller avec une protection

Merci de vos remarques mais mon problème n'est pas la fonction, c'est le fait que la feuille contenant le code sur l'evenement SelectionChange est censée être protégée mais si je laisse cette protection, je ne peux pas faire de copier coller dans cette feuille (les utilisateurs possèdent déjà les données qui doivent être contenues dans cette feuille et souhaiterait faire du copier coller pour s'éviter de tout resaisir...)

Merci de vos réactions
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
707
Réponses
14
Affichages
332
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
4
Affichages
581
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…