XL 2019 ActiveSheet.Paste ne fonctionne pas

eduraiss · 25 Février 2020

Bonjour le forum

Activeseeht.paste ne fonctionne pas voici le code
J'ai changé de version excel, le fichier était en 97 2003 il est maintenant en xlsm, avant pas de soucis

voici le code
Sub autoshape()

For n = ActiveSheet.Shapes.Count To 1 Step -1
If InStr(ActiveSheet.Shapes(n).Name, "Oval") <> 0 Or InStr(ActiveSheet.Shapes(n).Name, "AutoShape") <> 0 Then
ActiveSheet.Shapes(n).Delete
End If
Next n

colonnes = Array("B", "C", "E", "G", "I", "J")

For n = LBound(colonnes) To UBound(colonnes)
For m = 1 To 149
If Range(colonnes(n) & m) <> "" Then
If InStr(Range(colonnes(n) & m), "?") = 0 Then

Set c = Sheets("CODEDATE").Range("N3:W1000").Find(Range(colonnes(n) & m), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do

Select Case c.Column
Case 14
Sheets("CODEDATE").Shapes("Oval 10").Copy
Case 15
Sheets("CODEDATE").Shapes("Oval 94").Copy
Case 16
Sheets("CODEDATE").Shapes("Oval 95").Copy
Case 17
Sheets("CODEDATE").Shapes("Oval 96").Copy
Case 18
Sheets("CODEDATE").Shapes("Oval 97").Copy
Case 19
Sheets("CODEDATE").Shapes("Oval 98").Copy
Case 20
Sheets("CODEDATE").Shapes("Oval 99").Copy
Case 21
Sheets("CODEDATE").Shapes("Oval 100").Copy

End Select

ActiveSheet.Paste
If c.Column < 22 Then
Selection.Top = Range(colonnes(n) & m).Top + 2
Selection.Left = Range(colonnes(n) & m).Left + (c.Column - 14) * 8 + 2
Else

End If
Set c = Sheets("CODEDATE").Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next m
Next n
Range("A1").Select

End Sub

Merci de votre aide

laurent950 · 27 Février 2020

Bonjour,
#Job75 votre code est vraiment Magnifique et le meilleur de très loin.
#PatrickToulon Aussi un très très grand Merci à Patricktoulon qui m'aide beaucoup et avec qui j'apprend aussi.

Donc Patricktoulon (Macro VBA en Poste #42) :
* J'ai une intérogation avec cette variable : shap

La Fenêtre espion indique :
A) (Sans avoir placé en entête) OPTION EXPLICIT :
* shap ---->> Variant/Object/Rectangle

B) (Avec placé en entête) OPTION EXPLICIT :
* shap ---->> Variable non définit
En conclusion :
* dim shap as shape / Incompatibilité de type : avec --->> (Set shap = Selection)
* dim shap as shapes / Incompatibilité de type : avec --->> (Set shap = Selection)
Essaie avec :
* dim shap as Variant
* shap ---->>Variant/Object/Rectangle

* dim shap as Object
* shap ---->> Obeject/Rectangle

* dim shap as Rectangle
Ps : Etrange cela fonctionne !
* shap ---->> Rectangle/Rectangle

******************************************************************************************************
Pourquoi cela ne fonctionne pas avec :
* dim shap as shape / Incompatibilité de type : avec --->> (Set shap = Selection)
* dim shap as shapes / Incompatibilité de type : avec --->> (Set shap = Selection)

Si vous avez une réponse à mon intérogation je serais très content.

Ps : Un très grand Merci à PatrickToulon, et félicitation à Job75 pour son merveilleux Code en #Poste 43

Laurent

job75 · 27 Février 2020

laurent950 à dit:
Pourquoi cela ne fonctionne pas avec :
* dim shap as shape / Incompatibilité de type : avec --->> (Set shap = Selection)

Pourquoi vouloir être plus royaliste que le roi ? Puisqu'on vous dit que ça ne va pas utilisez :

VB:

Dim shap as Object

laurent950 · 27 Février 2020

job75 à dit:
Pourquoi vouloir être plus royaliste que le roi ? Puisqu'on vous dit que ça ne va pas utilisez :

Donc en conclusion vous ne savez pas non plus Job75 :
* dim shap as Object
* shap ---->> Obeject/Rectangle
Cela ne génére pas (Un Objet Shapes) puis aucune proposition des Méthode et propriétés de cet obejet shap générer avec (dim shap as Object)
donc :
shap. Rien de proposé après le Point qui suit l'objet (shap)
C'est juste histoire de savoir et comprendre et en aucun cas "être plus royaliste que le roi"
Ont sait ou Ont ne sait Pas ?

En tous cas merci Job75 cela conforte ma premiére idée et donc que c'est bien complexe ce model Objet Excel VBA.

Laurent

job75 · 27 Février 2020

laurent950 à dit:
Donc en conclusion vous ne savez pas non plus Job75

Je ne sais pas quoi ?

Il est évident que Selection n'est pas une Shape, un point c'est tout !

Faut pas passer son temps à enc… les mouches...

laurent950 · 27 Février 2020

job75 à dit:
Il est évident que Selection n'est pas une Shape, un point c'est tout !

Oui effectivement Job75 mais alors comment cela se fait t'il que l'ont ne puisse pas passer cette variable avec
dim shap as shape
tous simplement c'est incroyable de passer par
dim shap as object ?

C'est pour apprendre (des cas écoles comme ont dit) et ma culture personel Job75

job75 · 27 Février 2020

Ce que je constate c'est que laurent950 et patricktoulon adorent multiplier les posts même quand ils n'ont plus rien à voir avec la question initiale.

laurent950 · 27 Février 2020

Bon j'ai enfin trouvé

https://www.thespreadsheetguru.com/the-code-vault/vba-set-shape-variable-to-selected-shape

Essaie avec :
* dim shap as Shape
* shap ---->>Shape/Shape
* pour : Set shap = ActiveSheet.Shapes(Selection.Name)

Modification du code de avec l'instruction ci-dessus de Patricktoulon (Macro VBA en Poste #42) :

Pour Patricktoulon :
j'ai Modifié cela "mais quand tu parle de range évite de parler en "item" parle en "cells" se sera plus clair pour tout le monde"
Dim item1 As Range
Item1 ---> Cells1 ----->>> Dim Cells1 As Range
Dim item2 As Range
Item2 ---> Cells2 ------>>> Dim Cells2 As Range

Le Code : Ci-Dessous (Agrémenté est complété) :
* Module : Module1Patrick
* Code : testbisNettoyerPatrickToulon

VB:

Option Explicit
Sub testbisNettoyerPatrickToulon()
' ********************************************************************
    Dim FGroupSemaine As Worksheet
    Set FGroupSemaine = Worksheets("Groupe semaine")
    Dim Rg1 As Range
    Set Rg1 = Union(FGroupSemaine.Range(FGroupSemaine.Cells(1, 14), FGroupSemaine.Cells(FGroupSemaine.Cells(65536, 14).End(xlUp).Row, 14)), FGroupSemaine.Range(FGroupSemaine.Cells(1, 15), FGroupSemaine.Cells(FGroupSemaine.Cells(65536, 15).End(xlUp).Row, 15)))
    Dim Cells1 As Range
    Dim sh(1 To 2) As Shape
    Set sh(1) = FGroupSemaine.Shapes("AutoShape 13")
    Set sh(2) = FGroupSemaine.Shapes("Oval 93")
    ' ********************************************************************
    Dim Factive As Worksheet
    Set Factive = Worksheets(ActiveSheet.Name)
    Dim Rg2 As Range
    Set Rg2 = Union(Factive.Range(Factive.Cells(1, 3), Factive.Cells(Factive.Cells(65536, 3).End(xlUp).Row, 3)), Factive.Range(Factive.Cells(1, 5), Factive.Cells(Factive.Cells(65536, 5).End(xlUp).Row, 5)), Range(Factive.Cells(1, 7), Factive.Cells(Factive.Cells(65536, 7).End(xlUp).Row, 7)))
    ' *******************************************************************
    Dim s As Shape
    For Each s In Factive.Shapes
        If s.Name = sh(1).Name Or s.Name = sh(2).Name Then
            s.Delete
        End If
    Next s
    Dim shap As Shape
    Dim Cells2 As Range
    For Each Cells2 In Rg2
        If Cells2.Value <> Empty Then
            For Each Cells1 In Rg1
                If Cells1.Value = Cells2.Value Then
                    If Cells1.Column = 14 Then
                        With sh(1): .Copy: Factive.Paste: Set shap = ActiveSheet.Shapes(Selection.Name): End With
                        With shap
                            .Name = 15 & "-" & Cells2.Row
                            .Top = Cells2.Top
                            .Left = Cells2.Left
                        End With
                    ElseIf Cells1.Column = 15 Then
                        With sh(2): .Copy: Factive.Paste: Set shap = ActiveSheet.Shapes(Selection.Name): End With
                        With shap
                            .Name = 15 & "-" & Cells2.Row
                            .Top = Cells2.Top
                            .Left = Cells2.Left + Cells2.Width - .Width
                        End With
                    End If
                End If
            Next Cells1
        End If
    Next Cells2
End Sub

ps : Code en conclusion du Poste #42 au #52
Et le fichier excel qui Suit :

job75 · 27 Février 2020

Bah Selection.Name... Il peut y avoir beaucoup de Shapes avec le même nom !!!

Si l'on veut à tout prix déclarer shap As Shape utiliser :

VB:

Dim shap As Shape
For Each shap In ActiveSheet.Shapes
    If shap.Top = Selection.Top And shap.Left = Selection.Left Then Exit For
Next

patricktoulon · 27 Février 2020

je te l'ai dis Laurent ne fait plus tes expériences dans ce post ça fout le bor....
et certains ne manqueront pas de te le sonner et arrete de te disperser
maîtrise une chose après l'autre on a tout le temps
tranquille 😉

job75 · 27 Février 2020

C'est sûr, si tout le monde fait comme laurent950 ce forum deviendra illisible.

Pour ce genre d'exercice il y a les MP (conversations).

laurent950 · 27 Février 2020

Alors en conclusion un grand Merci à vous deux... je stope l'alimentation de ce Poste mais je suis super content d'avoir apris quelques choses.

Merci, Merci Merci... A Patricktoulon 😀 et à Job75 😀

The End

eduraiss · 3 Mars 2020

Bonjour a tous
Bonjour le forum
Je reviens avec vos différentes propositions
Désolé mais aucune ne fonctionne sur mon ordinateur office 2019, chez moi RAS (office 2016)
Donc je ne sais pas ça bug sur paste synthétiquement
Voila, il doit y avoir un truc dans excel qui fait cela, je ne pense pas que cela provienne du code

Merci encore

patricktoulon · 3 Mars 2020

re
bonjour tout les participants ont des versions différentes et plusieurs solution proposées fonctionnent chez tout le monde sauf chez toi
donc en effet tu dois avoir un problème de droit ou ton application excel est en vrac
en tout cas on est tous parti avec ton exemple me semble t il
fonctionne sur 2007,2010,2013,2016
les codes utilisé sont basiques et donc compatible toutes versions (me semble t il)et supérieure je serais curieux si MS avait changer cela pour 2019

job75 · 3 Mars 2020

eduraiss à dit:
Désolé mais aucune ne fonctionne sur mon ordinateur office 2019, chez moi RAS (office 2016)
Donc je ne sais pas ça bug sur paste synthétiquement

Bah mes macros des posts #26 #28 #36 #43 n'utilisent pas Paste, les avez-vous testées ?

eduraiss · 3 Mars 2020

Re bonjour
Bonjour job75
En effet autand pour moi
Je revois un fichier, j'ai rajouter une feuille avec mon besoin reel
est-ce possible de faire quelque chose
Car en effet cela

XL 2019 ActiveSheet.Paste ne fonctionne pas

eduraiss

XLDnaute Accro

laurent950

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

eduraiss

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

eduraiss

XLDnaute Accro

Discussions similaires

XL 2019 ActiveSheet.Paste ne fonctionne pas

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency