Copier coller un groupe d'objet via un bouton utilisant une macro

[lolostaps]

Bonjour à tous,

le problème que je rencontre est que je souhaite copier un ensemble d'objet que j'ai regrouper ensemble (nommé Poinçon test dans mon document ci joints vers une cellule cible E2.
La particularité de cette macro est qu'elle soit capable d'effectuer un saut de ligne dans la colonne E à chaque copier coller.
Sur le document joints la macro se trouve sur le bouton Sauvegarder le poinçon (cette macro marche avec une sélection de cellule sans objet sur un autre de mes fichiers)

Merci d'avance pour votre aide

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Bonjour lolostaps,

Voyez cette macro dans le fichier joint :

Sub CopieObjet()
[B3:C4].Merge 'au cas où...
If IsError([mem]) Then [E2].Name = "mem"
[B3:C4].Copy [mem]
[mem].Offset(1).Name = "mem"
End Sub

L'objet doit avoir la propriété Déplacer et dimensionner avec les cellules.

A+

 

[lolostaps]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Bonjour lolostaps,

Voyez cette macro dans le fichier joint :

Sub CopieObjet()
[B3:C4].Merge 'au cas où...
If IsError([mem]) Then [E2].Name = "mem"
[B3:C4].Copy [mem]
[mem].Offset(1).Name = "mem"
End Sub

L'objet doit avoir la propriété Déplacer et dimensionner avec les cellules.

A+

Merci Job75 pour ta réponse c'est exactement ce que je souhaitais, j'en profite pour te poser une autre question concernant toujours ce fichier et concernant du VBA il me semble:
Sur mon onglet 2 "Code balise":
- je souhaite créer une liste déroulante en face de chaque numéro de balise.
et je cherche à ce que celle ci m'affiche la base de données créer sur mon premier onglet colonne E afin de pouvoir attribuer à chaque balise un code poinçons référencé.
J'ai trouvé certaine réponse sur ce site et d'autres ou les utilisateurs avait réalisé ce système de liste déroulante avec des smileys le seul pb est que lorsque je m'intéressait au fonctionnent il avait juste utilisé une police Wingding et demandé à la liste déroulante d'affiché la police Winding plutot que le code arial.

merci d'avance

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Re,

Notez qu'on peut masquer le nom défini mem :

Sub CopieObjet()
[B3:C4].Merge 'au cas où...
If IsError([mem]) Then [E2].Name = "mem"
[B3:C4].Copy [mem]
ThisWorkbook.Names.Add "mem", [mem].Offset(1), Visible:=False
End Sub

Fichier (2).

A+

 

[lolostaps]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

c'est vraiment parfait juste une petite question concernant cette même macro , dans le cas ou j'efface la liste des copier coller la macro quant elle este reutiliser continu la ou elle s'était arrêter , est ce qu'il ya un moyen pour qu'elle reprenne à la première cellule vide?

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Re,

En réponse à votre poste #3 cette macro crée la liste Liste en colonne H (à masquer) :

Sub CopieObjet()
Dim i As Long, n As Long
[B3:C4].Merge 'au cas où...
If IsError([mem]) Then [E2].Name = "mem"
[B3:C4].Copy [mem]
ThisWorkbook.Names.Add "mem", [mem].Offset(1), Visible:=True
For i = 2 To [mem].Row - 2
  If Cells(i, "G") <> "" Then
    n = n + 1
    [H1].Offset(n) = Cells(i, "G")
  End If
Next
ThisWorkbook.Names.Add "Liste", [H2].Resize(n), Visible:=True
End Sub

Ici j'ai rendu les noms visibles pour pouvoir faire des tests.

Le nom Liste est utilisé pour les listes de validation dans la feuille "Code Balises".

Fichier (3).

A+

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Re,

Concernant maintenant votre post #5, si vous voulez redémarrer à zéro :

- supprimez tous les objets en colonne E

- supprimez les noms définis Liste et mem (il ne faut donc pas les masquer dans ce cas).

A+

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Re,

La remise à zéro (RAZ) peut se faire par cette macro :

Sub RAZ()
Dim o As Object, n As Long
For Each o In ActiveSheet.DrawingObjects
  If TypeName(o) = "GroupObject" _
    And o.TopLeftCell.Column = 5 Then o.Delete
Next
On Error Resume Next
ThisWorkbook.Names("mem").Delete
ThisWorkbook.Names("Liste").Delete
End Sub

Mais pour cela il faut que les groupes d'objets aient été renommés.

Le mieux est de le faire à la fin de la macro CopieObjet :

'---renomme les groupes---
n = 100000
For Each o In ActiveSheet.DrawingObjects
  If TypeName(o) = "GroupObject" Then
    n = n + 1
    o.Name = "Groupe_" & n 'renomme le groupe
  End If
Next
n = 0
For Each o In ActiveSheet.DrawingObjects
  If TypeName(o) = "GroupObject" Then
    n = n + 1
    o.Name = "Groupe_" & n 'renomme le groupe
  End If
Next

Fichier (4).

Nota : j'ai épuré la feuille, il y avait pas mal de reliquats d'objets (Ellipses).

A+

 

[lolostaps]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

vraiment merci job 75 c'est exactement le résultat que je souhaitais

 

[job75]

Re : Copier coller un groupe d'objet via un bouton utilisant une macro

Bonjour lolostaps, le forum,

Un détail, il vaut mieux entrer des formules de liaisons en colonne H :

[H1].Offset(n) = "=G" & i

Ainsi toute modification en colonne G est répercutée en colonne H.

Fichier (5).

A+