CODEWITHSUNDEEP
excelvba
Matthew Wilcox
Matthew Wilcox

Reputation: 19

VBA insert an image multiple times without copy,paste

Little bit of an odd question here.

On one of my excel sheets, I generate a pdf document.

The code runs by adding in segments of tables as required and manually setting a page break as needed so that a table isnt spread of a single page. (most tables are 5-10 rows)

at the bottom of each page, there is enough rows left over to insert an image. the image is just a few squares and a text box grouped together to provide a disclaimer and a signature box.

currently I have been using the

Sheets(...).shapes(...).copy
sheets(...).cells(...).pastespecial paste:=xlpasteall

with a few

doevents

to try make sure it runs correctly.

I keep running into the issues of 800401d0 method copy' of object 'shape' failed and error 1004 pastespecial method of range class failed.

I tthought it may have been becuase i did not have the doevents code but that has not remedied the situation.

I believe having the grouped shape saved as a single image embedded in the workbook may be easier so that I may use insert rather than copy.

the problem is I do not know how to go about this.

I could save the shapes as an image outside the worksheet, but when i do this, the quality drops and the text becomes blurry.

Any suggestions would be appreciated.

Thank you.

Upvotes: 1

Views: 428

Answers (1)

Tim Williams
Tim Williams

Reputation: 166755

I've had random odd problems pasting images in Excel, typically when running in a loop, and retrying the paste often succeeds, so you can try something like this, where the paste is retried until it succeeds (or a fixed number of tries still fail...)

Sub CopySomeThings()
    '...
    '...
    Thisworkbook.Sheets("source").Shapes("CopyThis").Copy
    PastePicRetry Thisworkbook.Sheets("destination").Range("A50")
    'etc etc
End Sub



'paste problem fix: keep trying until it works or for 20 tries
Sub PastePicRetry(rng As Range)
    Dim i As Long
    Do While i < 20
        On Error Resume Next
        rng.PasteSpecial
        If Err.Number <> 0 Then
            Debug.Print "Paste failed", i
            DoEvents
            i = i + 1
        Else
            Exit Do
        End If
        On Error GoTo 0
        i = i + 1
    Loop
End Sub

Upvotes: 2

Related Questions