Microsoft 365 Macro pour copier une image d'une feuille vers une autre

[fred69003]

Bonjour,
Je souhaite copier une image en la mettant dans une variable et ensuite la coller sur une autre feuille que j'ai créé : mon tableau ne comporte qu'une seule image.

Pour copier l'image dans ma variable j'ai écrit les lignes suivantes :

Dim image As Object Set image = ActiveSheet.Shapes("Picture 1")

ensuite je fais plein d'autres opérations (je ne peut donc pas faire un copier/coller basique), et je souhaite coller l'image dans ma nouvelle feuille (qui est désormais la feuille active) :

Range("A1").Value = image ActiveSheet.Paste

Mais ça ne fonctionne pas .

merci d'avance pour votre aide.

 

[Dudu2]

Bonjour,
Tu ne peux pas copier un Object (Shape) dans la Value d'une cellule.
Par contre la cellule peut être désignée comme Destination du Paste.
Par exemple:

Sub a()
    Dim Image As Object
    Set Image = ActiveSheet.Shapes(1)
    Image.Copy
    Worksheets(ActiveSheet.Index + 1).Activate
    ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
End Sub

 

[fred69003]

Bonjour Dudu2 et merci pour ta réponse rapide.
J'ai copié les 2 dernières lignes au moment ou je veux insérer l'image dans mon nouveau tableau mais ça ne fonctionne pas.
Je ne comprends pas à quoi sert l'avant dernière ligne et je ne vois pas où l'on dit que c'est "image" que l'on doit coller... merci de m'éclairer (j'ai du mal à comprendre la logique de la programmation en vba ). Ci-joint l'ensemble de ma macro si ça peut t'éclairer sur ce que je souhaite faire :

Sub Impressiondevis()

Dim style As Integer
    Application.ScreenUpdating = False
    msg = "Voulez-vous convertir l'étude de prix en devis client ?"
    style = vbYesNo + vbQuestion + vbDefaultButton1
    title = "Impression Devis"
    Response = MsgBox(msg, style, title)
    If Response = vbYes Then

'Détection du début et fin du récapitulatif
    Dim w As Object
    Set w = Range("A1:A99999").Find("drecap")
    Dim x As Integer
    x = w.Row
    Dim y As Object
    Set y = Range("A1:A99999").Find("frecap")
    Dim z As Integer
    z = y.Row


Dim calcultotaux As Variant                                           'création d'une variable pour enregistrer les formules des totaux
Dim designation As Variant
Dim Image As Object
calcultotaux = Range(Cells(1, 11), Cells(z, 11)).Formula              'désignation de la zone de la variable à copier
designation = Range(Cells(x + 1, 2), Cells(z - 1, 2)).Formula
Set Image = ActiveSheet.Shapes(1)                                     'copie du logo
Image.Copy

ActiveSheet.Range(Cells(1, 1), Cells(z, 11)).Copy                     'copie les données de la page active
Workbooks.Add                                                         'création d'un nouveau classeur

With Sheets("Feuil1").Range("A1").End(xlUp)
    .PasteSpecial Paste:=xlPasteValues                                'copie des valeurs
    .PasteSpecial Paste:=xlPasteFormats                               'copie des formats
    .PasteSpecial Paste:=xlPasteColumnWidths                          'copie des largeurs de colonnes
    .Application.CutCopyMode = False
End With

Range(Cells(1, 11), Cells(z, 11)).Value = calcultotaux
Range(Cells(x + 1, 2), Cells(z - 1, 2)).Value = designation



Columns("E:I").Delete Shift:=xlToLeft                                'supprime les colonnes E à I
Rows("1:2").Delete Shift:=xlToUp

Dim c As Range, fml$
    Application.ScreenUpdating = False
    For Each c In ActiveSheet.Range(Cells(x - 2, 6), Cells(z - 4, 6))
        fml = Replace(c.FormulaLocal, ";11;", ";6;")
        c.FormulaLocal = fml
    Next c

'Insert image
Worksheets(ActiveSheet.Index + 1).Activate
ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")

                             'mise en page :
                            
ActiveSheet.PageSetup.PrintTitleRows = "$6:$6"
                            
Application.ScreenUpdating = False
    DerLig = [A10000].End(xlUp).Row
    DerCol = [Xfd1].End(xlToLeft).Column
    Tableau = Cells(1, 1).Address & ":" & Cells(DerLig, DerCol).Address
    Range(Tableau).Select
    ActiveSheet.PageSetup.PrintArea = Tableau
    ActiveWindow.View = xlPageBreakPreview
    NbPage = ActiveSheet.HPageBreaks.Count + 1
    ActiveWindow.View = xlNormalView

With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "Impression du &D à &T"
        .CenterFooter = ""
        .RightFooter = "&P / &N"
        .LeftMargin = Application.InchesToPoints(0.3)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = NbPage
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
        
    End With


ActiveWindow.View = xlPageBreakPreview          'affichage en mode saut de page
ActiveWindow.Zoom = 100                         'affichage zoom à 100%

End If
End Sub

 

[Dudu2]

Retire l'instrution:

Worksheets(ActiveSheet.Index + 1).Activate

qui dans mon exemple sert à activer la feuille suivante.

 

[fred69003]

J'obtiens le message d'erreur suivant :

Erreur d'exécution '1004' :
La méthode Paste de la classe Worksheet a échoué.

J'ai l'impression que l'on ne va pas chercher l'image stocké dans la variable...

 

[Dudu2]

Je ne sais pas, au début tu avais Set image = ActiveSheet.Shapes("Picture 1")
Et là tu as repris mon exemple à la lettre: Set image = ActiveSheet.Shapes(1)
Mais c'est quoi le nom de ton image ? Si c'est "Picture1" garde-le.

ActiveSheet.Shapes("Picture 1") c'est la Shape de nom "Picture1"
ActiveSheet.Shapes(1) c'est la 1ère Shape dans la feuille

Les Shapes dans les feuilles c'est difficile à identifier.
Tu peux utiliser le classeur joint pour les identifier, renommer, supprimer.

Ton programme c'est un peu le chaos.
Regroupe les déclarations en tête de fonction, on y verra plus clair.
Met en tête de module Option Explicit. Ça oblige à déclarer toutes les variables utilisées ce qui est plus sûr. Certaines des variables ne sont pas déclarées.

 

[fred69003]

Merci je vais faire un peu de ménage alors... mais ça ne me dit toujours pas comment coller l'image depuis ma variable (peut être est-ce impossible ?)

 

[Dudu2]

Envoie ton fichier avec cette image et je regarderai.

 

[fred69003]

Ci-joint le fichier, la macro qui nous intéresse est Impressiondevis. Merci

 

[Dudu2]

Si tu fais Image.Copy puis juste derrière ActiveSheet.Range(Cells(1, 1), Cells(z, 11)).Copy, ton image n'est plus en Clipboard. Donc reporte le copy de l'image juste avant de la coller:

'Insertion image
Image.Copy                                                          'copie du logo
ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
Selection.Top = 0.75
Selection.Left = 0.75

D'autre part tu ajoutes un classeur, manipule des feuilles. Par contre aucun de tes objets ou presque n'est correctement qualifié. Donc tu n'es jamais sûr de savoir sur quoi tu travailles.

Une feuille c'est la feuille d'un classeur => <classeur>.feuille
<classeur>: ThisWorkbook, ActiveWorkbook, Workbooks("nom classeur"), Workbooks(n° classeur), Objet Workbook (Set WB1 = ActiveWorkbook)
Un Range c'est un Range d'une feuille => <classeur>.<feuille>.Range
<feuille>: ActiveSheet, Worksheets("nom feuille"), Worksheets(n° feuille), Objet Worksheet (Set WS1 = Activesheet)

Pour simplifier l'écriture on utilise l'instruction With.
With ThisWorbook.Workhseets("DPGF"), With WB1.Worksheets("Base"), With ActiveSheet, With WS1.Range("A1:A10"), etc...

 

[fred69003]

Merci beaucoup