VBA : Bouton contrôle de formulaire avec insertion forme et suppression ancienne

Version imprimable

1 pièce(s) jointe(s)

Bonsoir à tous,

le Fichier d'exemple est en pièce jointe.

tout d'abord je suis novice en macro. :oops:

Dans un classeur Excel (celui de l'exemple à 3 feuilles).

J'ai crée un Bouton contrôle de formulaire dans la feuille 1 qui recopie une forme contenant du texte situé aussi dans la feuille1 (le contenu qui est du texte, je le modifie à volonté quand je le souhaite).

J'ai déterminé les endroits où je souhaite recopier cette forme dans la feuille 2 et 3.

Par contre je souhaite que quand je clique sur le bouton il recopie la forme sur les autres feuilles et qu'il supprime les anciennes formes de la feuille 2 et 3, puis les remplacent par celle de la feuille 1.

Avec la macro que je détaille plus loin, le soucis est qu'il crée les formes mais me les décalent un peu et il superpose les anciennes, et envoi une invite de déboggage

En espérant avoir été clair....merçi de l'aide :oops:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Bouton10_Cliquer() ' ' Bouton10_Cliquer Macro ' ' ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.Copy Sheets("Feuil2").Select Range("A1").Select ActiveSheet.Paste Sheets("Feuil3").Select ActiveSheet.Shapes.Range(Array("Rectangle 5")).Select End Sub

Bonjour,

Teste ce code :

Code:

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
 
Sub Bouton10_Cliquer()
 
    Application.ScreenUpdating = False
 
    On Error Resume Next
    Worksheets("Feuil2").Shapes("Rectangle 1").Delete
    Worksheets("Feuil3").Shapes("Rectangle 1").Delete
    On Error GoTo 0
 
    Worksheets("Feuil1").Shapes("Rectangle 1").Copy
 
    With Worksheets("Feuil2")
 
        .Paste
        .Shapes("Rectangle 1").Top = 0
        .Shapes("Rectangle 1").Left = 0
 
    End With
 
    With Worksheets("Feuil3")
 
        .Paste
        .Shapes("Rectangle 1").Top = 0
        .Shapes("Rectangle 1").Left = 0
 
    End With
 
    Application.ScreenUpdating = True
 
End Sub

Hervé.

Bonjour,

Ca parait normal, car le copier/coller créé une nouvelle occurrence de ton objet "Rectangle 1" mais avec un nom différent.

Si tu essaies de sélectionner ton shape, de faire un CTRL+C, de sélectionner ta cellule de destination dans la feuille 2, et de faire un CTRL+V plusieurs fois, tu verras que les shapes créés se décalent progressivement et portent chaque fois un nom différent (rectangle 2,rectangle 3,rectangle 4)

Donc je pense que la solution de Hervé pour supprimer les shapes existantes ne fonctionnera pas (car Worksheets("Feuil2").Shapes("Rectangle 1") est inexistant)...

Tu peux essayer ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim obj As Object ' suppression des rectangles dans Feuil2 For Each obj In Feuil2.Shapes If obj.Name Like "Rectangle*" Then obj.Delete Next ' suppression des rectangles dans Feuil3 For Each obj In Feuil3.Shapes If obj.Name Like "Rectangle*" Then obj.Delete Next Feuil1.Shapes("Rectangle 1").Copy ' copie de rectangle 1 dans Feuil2 (à la cellule C24 par exemple) Feuil2.Paste Feuil2.Range("C24") ' copie de rectangle 1 dans Feuil3 (à la cellule E31 par exemple) Feuil3.Paste Feuil3.Range("E31") Application.CutCopyMode = False
Attention : si feuil2 ou feuil3 contiennent plusieurs shapes, elles seront toutes supprimées. Il faudrait alors, pour ne supprimer que la copie de ton rectangle 1, ajouter des conditions dans la première partie

20/02/2014, 17h04
Theze

Re,

Citation:

Donc je pense que la solution de Hervé pour supprimer les shapes existantes ne fonctionnera pas (car Worksheets("Feuil2").Shapes("Rectangle 1") est inexistant)...

Comme le shape est copié sur une autre feuille, il est géré de façon indépendante par rapport à celui qui a servi de modèle donc, si il est seul sur la feuille, ce qui est le cas car l'ancien a été supprimé, il sera nommé du même nom donc "Rectangle 1".

Hervé.

Citation:
Envoyé par Theze
Bonjour,

Teste ce code :
Code:

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 Sub Bouton10_Cliquer() Application.ScreenUpdating = False On Error Resume Next Worksheets("Feuil2").Shapes("Rectangle 1").Delete Worksheets("Feuil3").Shapes("Rectangle 1").Delete On Error GoTo 0 Worksheets("Feuil1").Shapes("Rectangle 1").Copy With Worksheets("Feuil2") .Paste .Shapes("Rectangle 1").Top = 0 .Shapes("Rectangle 1").Left = 0 End With With Worksheets("Feuil3") .Paste .Shapes("Rectangle 1").Top = 0 .Shapes("Rectangle 1").Left = 0 End With Application.ScreenUpdating = True End Sub
Hervé.
Bonjour,

j'ai essayé, mais il bloque en disant élément portant ce nom introuvable puis bloque .

Code:

Shapes("Rectangle 1").Top = 0

Feuil2
Citation:
Envoyé par Phil'oche
Bonjour,

Ca parait normal, car le copier/coller créé une nouvelle occurrence de ton objet "Rectangle 1" mais avec un nom différent.

Si tu essaies de sélectionner ton shape, de faire un CTRL+C, de sélectionner ta cellule de destination dans la feuille 2, et de faire un CTRL+V plusieurs fois, tu verras que les shapes créés se décalent progressivement et portent chaque fois un nom différent (rectangle 2,rectangle 3,rectangle 4)

Donc je pense que la solution de Hervé pour supprimer les shapes existantes ne fonctionnera pas (car Worksheets("Feuil2").Shapes("Rectangle 1") est inexistant)...

Tu peux essayer ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim obj As Object ' suppression des rectangles dans Feuil2 For Each obj In Feuil2.Shapes If obj.Name Like "Rectangle*" Then obj.Delete Next ' suppression des rectangles dans Feuil3 For Each obj In Feuil3.Shapes If obj.Name Like "Rectangle*" Then obj.Delete Next Feuil1.Shapes("Rectangle 1").Copy ' copie de rectangle 1 dans Feuil2 (à la cellule C24 par exemple) Feuil2.Paste Feuil2.Range("C24") ' copie de rectangle 1 dans Feuil3 (à la cellule E31 par exemple) Feuil3.Paste Feuil3.Range("E31") Application.CutCopyMode = False
Attention : si feuil2 ou feuil3 contiennent plusieurs shapes, elles seront toutes supprimées. Il faudrait alors, pour ne supprimer que la copie de ton rectangle 1, ajouter des conditions dans la première partie
Bonjour,

Il ouvre une fenêtre et indique Erreur de compilation : instruction incorrecte à l'extérieur d'une procédure et ouvre le débogueur ici :

Code:

For Each obj In Feuil2.Shapes

21/02/2014, 12h08
Phil'oche

Il faudrait que tu t'assures (dans la fenêtre VBA, menu outils/référence) que tu as bien chargé "Microsoft Excel xx Object Library" et "Microsoft Office xx Object Library" (xx dépend de ta version d'Excel)
22/02/2014, 15h25
anonymous9

il me dit erreur d'accès à la base de registration, j'ai lu l'aide mais ça ne m'aide pas plus.......:(

J'ai cherché et je pense avoir compris, je n'ai pas les droits d'administrateurs et ça ne peux pas fonctionner..... comment je pourrais faire ?
05/03/2014, 20h24
anonymous9

Bonjour,

Juste pour info si ça peux servir, j'ai cherché et trouver un moyen simple de faire ce que je souhaite : la fonction photo à ne pas confondre avec image.

Merci pour votre participation à résoudre mon problème