Copier / Coller en tant qu'Image

[Thekak]

Bonjour,

Je souhaiterai dans une macro effectuer un copier / coller d'une plage de cellules sur laquelle sont collées des formes (shapes) en tant qu'image.
Le but étant ensuite de pouvoir la redimensionner pour la faire loger dans un cadre bien défini.
Est-ce que quelqu'un pourrait m'aider pour ce type de prog.
Merci,

Bruno

 

[chris]

Re : Copier / Coller en tant qu'Image

Bonjour

Tu installes l'appareil photo dans la barre de lancement rapide : je ne sais dans 2007 s'il s'appelle photo ou appareil photo (il faut lister "toutes les commandes" et c'est classé par ordre alpha.

Ensuite tu utilises l'enregistreur macro et tu auras le code en principe.

Sinon reposte

 

[Thekak]

Re : Copier / Coller en tant qu'Image

j'ai essayé mais la prise de photo ne fonctionne pas en enregistrement de macro.
L'idée ma paraissait bonne pourtant...

 

[Thekak]

Re : Copier / Coller en tant qu'Image

J'ai essayé avec du code utilisé pour effacer des "shapes" dans une plage de cellule, en remplaçant .delete par .select :

For Each alv In ActiveSheet.Shapes
If Not Intersect(alv.TopLeftCell, Range(Cells(1, 2), Cells(32, 39))) Is Nothing Then alv.select
Next alv

Mais seule la dernière alvéole reste sélectionnée, il faudrait pouvoir coder le maintien de la touche CTRL pour que toutes les alvéoles de la plage soient sélectionnées au fur et à mesure de la boucle For.
Après il ne resterait plus qu'à ajouter pour coller l'image :

Range("A71").Select
ActiveSheet.PasteSpecial Format:="Image (PNG)", Link:=False, DisplayAsIcon _
:=False

Si quelqu'un a une idée, je suis preneur !!!

 

[chris]

Re : Copier / Coller en tant qu'Image

Bonjour

Je ne sais pas si ça marchera sur 2007 mais sur 2010 un enregistrement brut donne

Sub Macro2()
'
' Macro2 Macro
'

'
    Range("A5:B6").Select
    Range("B6").Activate
    Selection.Copy
    ActiveSheet.Shapes.AddShape(, 181.5, 260.25, 72#, 72#).Select
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Application.CutCopyMode = False
    Range("K5:L6").Select
    Range("L6").Activate
    Selection.Copy
    ActiveSheet.Shapes.AddShape(, 183#, 314.25, 72#, 72#).Select
    ActiveSheet.Shapes.Range(Array("Picture 2")).Select
    Application.CutCopyMode = False
End Sub

Espérant que ça aidera...