Interdire partiellement le collage depuis un autre Classeur ou d'un onglet

**stef3700** · 10/04/2017, 16h48

Bonjour a tous

Je suis a la recherche d'une solution suite a mon problème d'un code , car je suis novice en VBA..
Pour
*1 Comment faire pour ceci;
-Interdire le collage pour l'ongle de mon classeur A,B
-AUTORISE LE COLLAGE depuis tierce source.....Pour l'onglet C

*2 Comment faire pour ceci;

-Interdire le collage pour l'ongle de mon classeur A,B
-( Interdire pour: Mise en forme Conditionnelle.)
-( Interdire pour: Validation des données.)
-( Interdire pour: Liste déroulantes.)
-( Interdire pour: Sans les formules des cellules.)

*3 Donc justes de pouvoir AUTORISER de coller les textes seulement depuis un autre fichier, sans la mise en forme , Validation des données, liste déroulantes puis les formules des cellules ..

-Pour info j'ai mis les codes dans ThisWorkbook car dans les feuil1 ne fonctionne pas ? en VBA
-Car j'ai effectuer ces code mais il me bloque l'ensembles de mon classeur....

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
Private Sub Workbook_Open()
 'Interdit le tirage des formules dans les 4 directions et le glisser déplacer
  Application.CellDragAndDrop = False
 End Sub
 
 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 'Interdit le collage sur la même feuille que celle qui a servi à faire la copie
  Application.CutCopyMode = False
 End Sub
 
 Private Sub Workbook_Activate()
 'Interdit le collage suite à une copie venant d'un autre classeur
  Application.CutCopyMode = False
 End Sub
 
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
 'Active le tirage des formules dans les 4 directions et la technique du glisser-déplacer pour les cellules.
  Application.CellDragAndDrop = True
 
 'Active la possibilité de collage
  Application.CutCopyMode = True
 End Sub
 
Private Sub Worksheet_Activate()
 'Interdit le collage suite à une copie venant d'une autre feuille du même classeur
  Application.CutCopyMode = False
 End Sub

Merci d'avance pour votre aides

Cdt

**stef3700** · 11/04/2017, 02h24

Je répond a moi même après des recherches voici le code avec les cellules verrouiller en désactivent les objets plus scenarios bien sur..

Code :

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

1
2
3
4
 Sub Colage_Special_Valeur()
    Selection.PasteSpecial xlPasteValues
 
 End Sub

Le problème qu'il y a une erreur si il y rien de coller .

Que faut-il renseigner dans mon code ??
De laide SVP

Merci

**unparia** · 11/04/2017, 07h22

Bonjour

Le problème qu'il y a une erreur si il y rien de coller

Cette phrase laisse planer plusieurs doutes. Comment faut-il la traduire :
1) par s'il n'y a rien à coller ?
2) s'il n'en résulte rien de collé ?
Peux-tu par ailleurs préciser quelle est cette erreur et comment, où et à quel moment elle se manifeste ?

**stef3700** · 11/04/2017, 12h17

Oui effectivement je me suis mal exprimée
Donc voici ma situation
J'ai créé un bouton avec se code
Donc si il y a rien de coller dans presse papier j'ai une erreur.
Comment contourner se problème.

Merci

**unparia** · 11/04/2017, 12h27

Bis repetita, donc (et il n'y aura pas de troisième question sur ce même point -->> juste abandon pur et simple) --->>

Peux-tu par ailleurs préciser quelle est cette erreur et comment, où et à quel moment elle se manifeste ?

C'est quand même fort, d'en arriver là !

**stef3700** · 11/04/2017, 13h25

Ou la la cool
juste pour info Jai comme message
Erreur exécution 1004
la méthode PasteSpecial de la classe Range a échoué.

**stef3700** · 13/04/2017, 01h39

Bonsoir voici plus de detail

j'ai crée un bouton contrôle formulaire pour Collée un ensemble de cellule de mon choie avec comme code pour collée juste les textes
depuis le presse papier office.
Cela fonctionne correctement mais le problème si il y a rien dans le presse papier si je clic sur le bouton j'ai un message d'erreur ( normal car il a rien a collée).

Donc y a-t-il un code pour bloqué l'action du bouton si le presse papier vide ..
Voila pour les explications car en VBA je suis débutant
Voici le code que j'utilise depuis l'aide
Merci pour votre aide car la je coince

Code :

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

1
2
3
4
5
6
7
8
9
Sub Colage_Special_Valeur()
    'copier uniquement les valeurs
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    'désactive la fonction copier de la source
        Application.CutCopyMode = False
 
End Sub

**RyuAutodidacte** · 13/04/2017, 03h02

Bonsoir,

es tu sur de choisir la bonne solution ? : à voir => https://www.developpez.net/forums/d1...le-protection/
et ceci sans vba et il y a moyen de faire fonctionner des macros

**stef3700** · 13/04/2017, 05h47

bonsoir
oui bien sur car la source vient de divers fichiers par de diverse personnes.
Donc pour évité le faire la bazar dans mon fichier je cette solution

en faite j'avance
avec le CommandButton1_Click() avec comme code

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
Private Sub CommandButton1_Click()
 
Dim refcopier As Range, refcoller As Range, i As Integer
Dim copierstring As String, collerstring As String
Set refcopier = Application.InputBox("Sélectionner les cellules à copier" & Chr(10) & "Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules", Type:=8)
copierstring = refcopier.Address
Set refcoller = Application.InputBox("Sélectionner les cellules de destination" & Chr(10) & "Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules", Type:=8)
collerstring = refcoller.Address
If copierstring Like "*:*" Then
    refcoller.Value = refcopier.Value
ElseIf copierstring Like "*,*" Then
  For i = 0 To UBound(Split(refcopier.Address, ","))
    Range(Split(refcoller.Address, ",")(i)) = Range(Split(refcopier.Address, ",")(i))
  Next i
Else
  refcoller.Value = refcopier.Value
End If
End Sub

Donc y a-t-il un code pour bloqué l'action du bouton si le presse papier vide ..

Merci bonne nuit je vais me coucher

A Plus

**unparia** · 13/04/2017, 06h39

juste pour info Jai comme message
Erreur exécution 1004
la méthode PasteSpecial de la classe Range a échoué.

Non, pas "juste pour info". Par respect des règles de ce forum.

http://club.developpez.com/regles/
Chapitre III - C

**RyuAutodidacte** · 13/04/2017, 11h03

Re,

2 solutions :

- soit c'est moi qui n'est rien compris à ton problème (ce qui peut être possible), mais je ne le pense pas.

- soit tu n'as pas pris le temps de bien regarder le lien que je t'ai donné et de réfléchir aux solutions.
Pour cela il faudrait tester et se renseigner sur ce qui a été dit sur le post du lien fourni.
À savoir que tout les blocages demandés sont là et que ta fameuse macro que tu veux faire appliquer est tout à fait possible.

Dans la macro tu pourrais vider le presse papier, faire mettre la valeur à retourné dans un inputbox sur la cellule sélectionnée … etc …

Un tour dans la

ne fait pas de mal. Déjà en la parcourant tu aurais pu trouver ceci : Le presse papier

**stef3700** · 25/04/2017, 17h55

Bonsoir

Je comprend pas Jai besoin d'aide pour mon code car si j'annule Jai une erreur d'exécution 424 .

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
Private Sub CommandButton1_Click()
 
Dim refcopier As Range, refcoller As Range, i As Integer
Dim copierstring As String, collerstring As String
Set refcopier = Application.InputBox("Sélectionner les cellules à copier" & Chr(10) & "Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules", Type:=8)
copierstring = refcopier.Address
Set refcoller = Application.InputBox("Sélectionner les cellules de destination" & Chr(10) & "Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules", Type:=8)
collerstring = refcoller.Address
If copierstring Like "*:*" Then
    refcoller.Value = refcopier.Value
ElseIf copierstring Like "*,*" Then
  For i = 0 To UBound(Split(refcopier.Address, ","))
    Range(Split(refcoller.Address, ",")(i)) = Range(Split(refcopier.Address, ",")(i))
  Next i
Else
  refcoller.Value = refcopier.Value
End If
End Sub

J'ai pas trouvé sur la FAQ je suis novice..

Merci par avance
Stef

**Marc-L** · 25/04/2017, 17h58

Bonjour, bonjour !

Où cela donc ? Et ce n'est vraiment pas compliqué de tester la valeur renvoyée !

Voilà, voilà !

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Marc-L** · 25/04/2017, 18h11

Je n'avais pas vu l'utilisation de l'autre InputBox, mais le principe reste le même : juste vérifier !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Const S = vbLf & "Sélectionner les cellules à copier" & vbLf & "Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules"
Dim refcopier As Range, refcoller As Range
 
On Error Resume Next
Set refcopier = Application.InputBox(S, Type:=8)
 If refcopier Is Nothing Then Exit Sub
Set refcoller = Application.InputBox(Replace(S, "à copier", "de destination"), Type:=8)
 If refcoller Is Nothing Then Set refcopier = Nothing: Exit Sub
On Error GoTo 0
 
    refcopier.Copy refcoller
Set refcopier = Nothing:  Set refcoller = Nothing

___________________________________________________________________________________________________________

Merci de cliquer sur

en bas à droite de chaque message ayant aidé puis sur

pour clore cette discussion …

**stef3700** · 25/04/2017, 21h18

Merci ça se rapproche de se qui me faut
il manque plus que pour collée seulement les valeurs des cellules.....

J'ai essayer avec

Code :

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

1
2
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Mais rien a faire je ne comprend plus rien
de laide SVP

Merci

**RyuAutodidacte** · 25/04/2017, 21h58

bonsoir,

Code :

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

refcoller.Value = refcopier.Value

**stef3700** · 25/04/2017, 22h58

Merci a vous

Presque ça ; car avec le code de Marc-L le fait de collée il colle l’ensemble des cellules mais avec les couleur mise en forme Etc, si la source en a .

Avec l'information de RyuAutodidacte le collage correct ( juste les valeurs de la source ) mais il ne colle que la première cellules ou je ne vois pas ou poser cette ligne .

En attente pour les échanges

Merci

Stef

**RyuAutodidacte** · 25/04/2017, 23h15

j'ai testé pour 3 valeurs il colle bien les 3 valeurs,
j'ai juste utilisé le code de Marc-L et remplacé : refcopier.Copy refcoller par refcoller.Value = refcopier.Value
À savoir, j'ai sélectionné le même nombre de cellules à chaque fois pour le copier et le coller

sinon le faire comme cela en sélectionnant une seule cellule pour coller :

Code :

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

1
2
    refcopier.Copy
    refcoller.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

qui peut s'écrire comme cela de manière plus courte :

Code :

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

1
2
    refcopier.Copy
    refcoller.PasteSpecial xlPasteValues

**stef3700** · 25/04/2017, 23h41

Merci RyuAutodidacte ; Marc-L

Nickel Fonctionne parfaitement

juste une dernière chose pour le message a coller je voudrais changer le texte (Appuyer sur Ctrl ou Glisser pour sélectionner plusieurs cellules) en cliquer sur la 1er cellule

Merci