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

**anonymous9** · 19/02/2014, 22h41

Bonsoir à tous,

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

tout d'abord je suis novice en macro.

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

Code :

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

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

**Theze** · 20/02/2014, 08h41

Bonjour,

Teste ce 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
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é.

**Phil'oche** · 20/02/2014, 09h19

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 :

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
 
    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

**Theze** · 20/02/2014, 17h04

Re,

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é.

**anonymous9** · 20/02/2014, 20h41

Envoyé par Theze

Bonjour,

Teste ce 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
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 :

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

Shapes("Rectangle 1").Top = 0

Feuil2

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 :

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
 
    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 :

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

For Each obj In Feuil2.Shapes

**Phil'oche** · 21/02/2014, 12h08

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)

**anonymous9** · 22/02/2014, 15h25

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 ?

VBA : Bouton contrôle de formulaire avec insertion forme et suppression ancienne [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager