复制和将一张纸上的图片粘贴到另一张纸上 [英] copy & paste a picture from one sheet to another

问题描述

我使用以下代码创建了一个小程序，将图片从一张纸转移到同一工作簿中的另一张纸。

I created a small program using the following code to transfer a picture from one sheet to another in the same workbook.

Sub transferPicturesPAPER_EXAM(pictureNo As Long, p As Integer, srcSht As String, dstSht As String, insertWhere As String)
'   Transfers the selected Picture to the exam sheet.
''zxx

    If pictureNo = 0 Then Exit Sub
    Sheets(srcSht).Select
    ActiveSheet.Unprotect
    ActiveSheet.pictures("Picture " & pictureNo).Select
    'ActiveSheet.Shapes.Range(Array("Picture " & pictureNo)).Select
    Selection.Copy

    Sheets(dstSht).Select
    Range(insertWhere).Select
    ActiveSheet.Paste

    '== rename to correspond to the problem number
    Selection.Name = "Picture " & p
End Sub

这很好。但是，当我将例程放在更大的工作簿中时，在行中出现以下错误： Activesheet.paste ：

This works fine. However, when I place the routine in a larger workbook, I get the following error at the line: Activesheet.paste:

Worksheet类的粘贴方法失败

Paste method of Worksheet class failed

该代码在多个程序执行中都能正常工作。

The code worked fine for several program executions.

任何帮助将不胜感激。

推荐答案

我经常遇到这个问题太。但是您不能等待每张照片3秒，这太长了。我正在处理1000张照片，它将永远使用。

I often had this problem too. But you cannot wait 3 seconds per picture , it's too long. I work on 1000 pictures, it's gonna take for ever.

问题的核心是Excel首先复制到Windows剪贴板，这很慢。

The core of the problem is that Excel copies to windows clipboard first, which is slow.

如果您尝试在剪贴板上贴上Pic之前粘贴，它将出错。

If you try to paste before the clipboard has the Pic , its will error.

因此，大量复制需要一些小步骤：

So, some small steps needed for mass copying:

• 清除剪贴板（并非始终需要，但可以确保您不使用较旧的数据）


• 复制Pic


• 测试Pic是否在剪贴板中，然后等待直到出现（循环）


• 粘贴

• Clear clipbard (not always needed but it makes sure you are not working on older data)
• Copy Pic
• Test if Pic is in the Clipboard and wait until it is there (loop)
• Paste

以下是代码（适用于Excel 64位）：

Here is the code (for Excel 64 bits) :

Option Explicit

'Does the clipboard contain a bitmap/metafile?
Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

'Open the clipboard to read
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal Hwnd As LongPtr) As Long

'clear clipboard
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

'Get a pointer to the bitmap/metafile
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr 'wformat as long ?


'Close the clipboard
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long


'for waiting
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Clear_Clipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
Application.CutCopyMode = False
End Sub



Sub PastePic(Pic As Shape)
                    Dim Rg As Range
                    Dim T#
                    Dim Ligne&: Ligne = 5
                    Dim Sh_Vendeur As Worksheet
                    Set Sh_Vendeur = ThisWorkbook.Sheets(1)

                    Clear_Clipboard

                    Pic.Copy
                    Set Rg = Sh_Vendeur.Cells(Ligne, 2)

                    'wait until the clipboard gets a pic, but not over 3 seconds (avoid infinite loop)
                    T = Timer
                    Do
                          Waiting (2)
                    Loop Until Is_Pic_in_Clipboard Or Timer - T > 0.3

                    'Rg.Select
                    'Rg.PasteSpecial
                    Sh_Vendeur.Paste Destination:=Rg 'paste to a range without select
End Sub


Sub Waiting(ByVal Mili_Seconds&)
Sleep Mili_Seconds
End Sub

Function Is_Pic_in_Clipboard() As Boolean
If IsClipboardFormatAvailable(2) <> 0 Or IsClipboardFormatAvailable(14) <> 0 Then Is_Pic_in_Clipboard = True '2-14 =bitmap et Picture JPEG
End Function

这篇关于复制和将一张纸上的图片粘贴到另一张纸上的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！