Discussion :

[LentilleLocale]

Bonjour à tous
Dans un onglet Sheet excel protégé où des cellules sont verrouillées et d'autres pas, j'aimerai que les cellules non verrouillées, qui ont une mise en forme prédéfinies (format, couleur, formats conditionnels, validation, etc), conservent leur mise en forme et que seule leurs valeurs puissent être modifiables soit par saisie directe ou soit par copier-coller par valeur.
La solution doit fonctionner quel que soit le paramétrage d'excel de l'utilisateur.

Je joins un fichier test pour mieux me faire comprendre. Voir mon 3ème post (3ème version)
Je n'ai réussi qu'à empêcher tous les copier-coller sur la feuille Dest.

Comment n'autoriser que le copier-coller valeur afin de conserver la mise en forme, et les tests de Domaine de valeurs ?

Merci pour votre aide
Bien cordialement
Lionel

[LentilleLocale]

Personne pour me répondre ?

Grace à Kiki29 qui répondait à une question similaire le 18/06/2008 sur un autre forum

Je croyais avoir trouvé pour partie réponse à mon propre problème ce Samedi 01/11/2008 à 16 heures
Voir pièce jointe mais cela ne fonctionne pas ou pas bien.

Mais j'aurai besoin de votre aide pour trouver l'erreur et résoudre les points suivants à moins que vous n'ayez une autre idée.

Merci à celui ou ceux qui voudront bien s'y intéresser.

1) Il faut soit inhiber le clic droit soit gérer le copier et le coller à l'aide du bouton droit de la souris
2) Dans le menu Edition, il reste à gérer le choix Recopier ou alors l'interdire
3) Enfin, comment faire pour vérifier que le collage respecte bien le domaine de valeur ?
Si la valeur d'une des zones en copie, ne respecte pas le domaine de valeur défini dans Validation, alors
il ne faut pas coller mais afficher un message indiquant la zone concernée

Merci beaucoup pour votre aide.

[LentilleLocale]

J'avance mais malheureusement tout seul.
Cela fonctionne mais uniquement si l'utilisateur utilise les raccourcis Ctrl C et Ctrl V. S'il passe par le menu, le copie coller par valeur n'est pas forcé.

Il me reste 3 choses à trouver. Si quelqu'un a une idée , je suis preneur.
1) Comment faire en sorte que les Coller du menu Edition ou clic droit exécutent le code associé au Onkey ?

2) ou alors comment ne pas afficher le menu à la limite ?


3) Au niveau du Copier Coller par Valeur, est-il possible avant de coller de vérifier que la valeur respecte le domaine de valeur ?
Et ce pour chaque cellule … Si au moins 1 cellule du copier/coller valeur est hors du domaine alors ne pas copier et afficher une boîte de dialogue
indiquant les désaccords .

[fring]

Bonjour,

Ceci devrait te permettre de voir le bout du tunnel

• A insérer dans un module standard
  

  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
  Sub coller_off()
  With CommandBars(1).Controls("Edition")
      .Controls("Coller").Enabled = False
      .Controls("Collage spécial...").Enabled = False
  End With
  With CommandBars("Cell")
      .Controls("Coller").Enabled = False
      .Controls("Collage spécial...").Enabled = False
      On Error Resume Next
      With .Controls.Add(msoControlButton, , , 3, True)
          .Caption = "Coller la valeur"
          .OnAction = "Col_valeur"
      End With
  End With
  End Sub
   
  Sub coller_on()
  With CommandBars(1).Controls("Edition")
      .Controls("Coller").Enabled = True
      .Controls("Collage spécial...").Enabled = True
  End With
  With CommandBars("Cell")
      .Controls("Coller").Enabled = True
      .Controls("Collage spécial...").Enabled = True
      On Error Resume Next
      .Controls("Coller la valeur").Delete
  End With
  End Sub
   
  Sub Col_valeur()
      On Error Resume Next
      Selection.PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  End Sub

• A insérer dans le module ThisWorkbook
  

  Code :

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

  1
  2
  3
  4
  5
  6
  7
  Private Sub Workbook_BeforeClose(Cancel As Boolean)
  coller_on
  End Sub
   
  Private Sub Workbook_Open()
  coller_off
  End Sub

Les boutons "Coller" ou "Collage spécial" du menu Edition et du menu contextuel sont désactivés. Un nouveau bouton "Coller valeur" est créé dans le menu contextuel (clic droit)

Cdlt

[LentilleLocale]

Merci beaucoup Fring . Je découvre votre réponse alors que je viens de terminer ma version 3 qui fonctionne.

Reste cependant 2 choses à faire : en fait 1 à 19h ce dimanche

1) Gérer le menu contextuel (clic droit) pour inhiber et ajouter mes propres menus pour Copier, Coller, Couper comme je l'ai fait dans le menu Edition qui en interne s'appelle "Edit"
Je suppose que dans votre réponse, le menu contextuel de la commande barre s'appelle "Cell" ? Est-ce bien cela ? Je vais tester. Car il suffit alors de rajouter quelques lignes pour résoudre ce point 1. C'était bien ça. J'ai donc ajouté quelques lignes dans le fichier joint. Le point 1 est donc résolu Merci Fling pour le nom Cell : cela m'a évité de rechercher parmi tous les menus !
Et "Edition" c'est "Edit" ? les 2 sont acceptés ?

2) Au niveau de mon Copier Coller par Valeur, est-il possible avant de coller de vérifier que la valeur respecte le domaine de valeur ?
Et ce pour chaque cellule … Si au moins 1 cellule du copier/coller valeur est hors du domaine alors ne pas copier et afficher une boîte de dialogue
indiquant les désaccords . --> peut-être par Sendkey ? Enter

Avez-vous une idée pour ce 2ème point ?
Voir fichier joint

Je pense que cela pourra intéresser d'autres personnes de pouvoir gérer les copier coller tout en respectant la mise en forme et les domaines de valeur.

A bientôt de vous lire pour le point 2 qui reste à résoudre.

[DarkVader]

Bonsoir,
Le plus propre serait de faire un hook sur la notification d'évènements et les traiter en fonction des circonstances.
Il existe un exemple sur allapi : adapter le code avec WM_CHANGECBCHAIN à la place de WM_DRAWCLIPBOARD

[LentilleLocale]

Merci Darkvader
mais pouvez-vous me dire où se trouve allapi pour trouver l'exemple
et ce qu'est un hook ?

Cordialement

Il me semble que le test de valeur (comparaison avec ce qui est dans Validation) doit se faire dans cette routine :

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
Public Sub DoPaste()
    Debug.Print "DoPaste Ctrl V"
    On Error Resume Next
 
 
    If Application.CutCopyMode And Not mRngSource Is Nothing Then
        Selection.PasteSpecial xlValues
 
        Debug.Print mRngSource.Address ' Adresses départ Source ex : $F$15:$G$16
        Debug.Print Selection.Address  ' Adresses destination   ex : $H$19:I$20
        ' Comment vérifier que les données respectent le domaine de valeurs ?
        'Range(Selection.Address).Select
        'SendKeys "{ENTER}", True
 
        If mbCut Then mRngSource.ClearContents
 
        Application.CutCopyMode = False
 
    Else
        ActiveSheet.Paste
    End If
End Sub

[DarkVader]

Merci Darkvader
mais pouvez-vous me dire où se trouve allapi pour trouver l'exemple .../...

http://allapi.mentalis.org/apilist/SetClipboardViewer.shtml#
Google ou ma signature vous en aurait dit autant.

et ce qu'est un hook ?

Le subclassing consiste à intercepter les messages système émis par Windows afin de les retraiter.
Dans le cas qui nous intéresse il s'agit d'intercepter la notification de modification de la chaine texte du clipboard (WM_CHANGECBCHAIN).

[LentilleLocale]

Merci. Je vais aller suivre ce lien pour comprendre.

En attendant, j'ai terminé ce que je voulais faire en ajoutant du code là où je pensais que la chose devait se passer pour tester le respect du domaine de valeurs de la ou les cellules collées. Le code est le suivant et le fichier définitif est en pièce jointe de ce post. Je clôture ce sujet de discussion.
Mais si vous avez des remarques, des améliorations à apporter, des erreurs détectées, merci de me le faire savoir.
Bonne soirée à tout le Forum
Lionel

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
Public Sub DoPaste()
    Debug.Print "DoPaste Ctrl V"
    On Error Resume Next
 
 
    If Application.CutCopyMode And Not mRngSource Is Nothing Then
        Selection.PasteSpecial xlValues
 
        Debug.Print mRngSource.Address ' Adresses départ Source ex : $F$15:$G$16
        Debug.Print Selection.Address  ' Adresses destination   ex : $H$19:$I$20
        Debug.Print Selection.Row
        Debug.Print Selection.Column
        ' Comment vérifier que les données respectent le domaine de valeurs ?
        MonAdresse = Selection.Address
        Pos1 = InStr(1, MonAdresse, "$")
        Pos2 = InStr(Pos1 + 1, MonAdresse, "$")
        ColDebDest = Lettre2NumCol(Mid(MonAdresse, Pos1 + 1, Pos2 - Pos1 - 1))
        LigneDebDest = Mid(MonAdresse, Pos2 + 1)
 
        Pos3 = InStr(Pos2 + 1, MonAdresse, ":")
        If Pos3 = 0 Then
            ' 1 seule cellule
            LigneDebDest = Mid(MonAdresse, Pos2 + 1)
            ColFinDest = ColDebDest
            LigneFinDest = LigneDebDest
        Else
            ' Plusieurs cellules dans la Sélection
            Pos4 = InStr(Pos2 + 1, MonAdresse, "$")
            Pos5 = InStr(Pos4 + 1, MonAdresse, "$")
            ColFinDest = Lettre2NumCol(Mid(MonAdresse, Pos4 + 1, Pos5 - Pos4 - 1))
            LigneDebDest = Mid(MonAdresse, Pos2 + 1, Pos4 - Pos2 - 2)
            LigneFinDest = Mid(MonAdresse, Pos5 + 1)
        End If
        OK = True
        For MaCol = ColDebDest To ColFinDest
            For MaLig = LigneDebDest To LigneFinDest
                If Cells(MaLig, MaCol).Validation.Value = False And Cells(MaLig, MaCol).Validation.AlertStyle = xlValidAlertStop Then
                    MonTitre = Cells(MaLig, MaCol).Validation.ErrorTitle
                    MonMessage = "Le contenu cellule " & NumCol2Lettre(MaCol) & MaLig & " n'est pas conforme au domaine de valeurs."
                    MonMessage = MonMessage & vbCrLf & "Merci de corriger maintenant." & vbCrLf & vbCrLf
                    MonMessage = MonMessage & Cells(MaLig, MaCol).Validation.ErrorMessage
                    Rep = InputBox(MonMessage, MonTitre)
                    Cells(MaLig, MaCol) = Rep
                    MaCol = ColDebDest     ' on boucle tant que ce n'est pas bon
                    MaLig = LigneDebDest - 1
                End If
            Next MaLig
        Next MaCol
 
        'Range(Selection.Address).Select
        'SendKeys "{ENTER}", True
 
        If mbCut Then mRngSource.ClearContents
 
        Application.CutCopyMode = False
 
    Else
        ActiveSheet.Paste
    End If
End Sub