Excel VBA copier une image la nommer pour la coller plus tard

[fb62840]

Bonjour à toutes et à tous,

Voici le contexte :

Je créée une image à partir d'une zone

Sheets(1).Range("A1:C7").CopyPicture xlScreen, xlBitmap

Ce que j'aimerais parvenir à faire :
Je vais avoir de multiples images à gérer (toutes créées depuis la même zone sur un nombre variable de feuilles)
J'aimerais pouvoir stocker ces images dans une array afin de pouvoir ensuite en disposer pour les placer où il conviendra

Le fichier en pièce-jointe présente 3 feuilles (elles pourraient être bien plus nombreuses)
Sur chacune des 3 feuilles je souhaite créer une image correspondant à la zone A1:C7
Chacune de ces images devant être ultérieurement placée sur un autre classeur (qui n'existe pas encore au moment de la création des images)

Merci pour vos suggestions,

Bonne journée

 

[pierrejean]

Re : Excel VBA copier une image la nommer pour la coller plus tard

Bonjour fb62840

Une possibilité de stocker dans un tableau public les noms attribués a chacune des zones
execute la macro stock et tu disposeras d'un tableau dans lequel tu auras les noms des zones: nomfich

 

[fb62840]

Re : Excel VBA copier une image la nommer pour la coller plus tard

Bonjour Pierrejean,

Merci pour cette réponse rapide et de qualité (comme toujours).
C'est en effet une excellente idée de nommer les plages telle que vous le proposez dans la macro.

Par contre j'ignore ensuite comment coller à destination les différentes images en leur assignant des cellules de destination (la première image en A1, la seconde en D1, la troisième en G1 par exemple).

Merci,

 

[fb62840]

Re : Excel VBA copier une image la nommer pour la coller plus tard

Bonjour à toutes et tous,

Je suis parvenu à une solution en utilisant la proposition de Pierrejean que j'ai adapté avec les éléments d'une autre macro qui transforme la sélection en gif.

en voici le code :

Public NomFich()
Sub stock()
ReDim NomFich(0)
Dim Nms As Name
Dim LeGraph As Object
Dim Fich As String
Application.ScreenUpdating = False
Dim Tablgifs()

N = 1

For Each sh In Sheets
  ActiveWorkbook.Names.Add Name:="Fiche" & N, RefersToR1C1:="=" & sh.Name & "!R1C1:R27C3"
  NomFich(UBound(NomFich)) = "Fiche" & N
  ReDim Preserve NomFich(UBound(NomFich) + 1)
  N = N + 1
Next
 ReDim Preserve NomFich(UBound(NomFich) + 1)

For Each Nms In Names
    If Left(Nms.Name, 5) = "Fiche" Then
        Range(Nms.Name).CopyPicture
        Set LeGraph = ActiveSheet.ChartObjects.Add(0, 0, Range(Nms.Name).Width, Range(Nms.Name).Height)
        LeGraph.Chart.Paste
        Fich = ActiveWorkbook.Path & "\" & Nms.Name & ".gif"
        
Next Imgif
        LeGraph.Chart.Export Filename:=Fich, FilterName:="GIF"
        LeGraph.Delete
    End If
Next Nms
MsgBox (Tablgifs(i))
End Sub