excel vb.net 中图片类的粘贴/剪切方法失败

问题描述

我编写了一个子程序来将所有 Excel 表格中的图像连同图像的旧表格名称、图片顶部和左侧位置、高度和宽度移动到新表格。
移动几张图像后，我随机收到错误“图片类的剪切方法失败”或“图片类的粘贴方法失败”。如果我再次运行子程序，它将起作用，并且在几张纸后再次出错。

我在剪切和粘贴后添加了 0.3 秒的延迟。谁能建议我解决这个问题？

附加信息：我使用的是 windows 10、Microsoft Surface 2、office 365。过去我遇到了 windows 剪贴板的问题，其中文件（大小以 kb 为单位）即使在 10 秒后也没有被复制到剪贴板中，但现在不是.

Sub move_image()
            Dim Pic As Object
            Dim ws1 As Excel.Worksheet
            Dim startsheet,rw,i As Integer
            Dim Actwb As Excel.Workbook
            rw = 0
            Actwb = Globals.ThisAddIn.Application.ActiveWorkbook
            '' start from sheet number
            startsheet = InputBox("Enter Sheet position from where Picture to be moved")
            i = 1
            '' insert new All Pictures sheet
            ws1 = Actwb.Sheets.Add(Before:=Actwb.Sheets(1))
            ws1.Name = "All Pictures"
            For Each sh In Actwb.Sheets
                If i > startsheet Then
                    '' skip All Pictures sheet
                    If sh.Name = "All Pictures" Then GoTo skip_move_image : 
                    '' image list with sheet number,location and actual image at each 10 row
                    For Each Pic In sh.Pictures
                        Actwb.Sheets("All Pictures").Range("A1").Offset(rw,1) = sh.Name
                        Actwb.Sheets("All Pictures").Range("A1").Offset(rw,2).Value = Pic.Top
                        Actwb.Sheets("All Pictures").Range("A1").Offset(rw,3).Value = Pic.Left
                        Actwb.Sheets("All Pictures").Range("A1").Offset(rw,4).Value = Pic.Height
                        Actwb.Sheets("All Pictures").Range("A1").Offset(rw,5).Value = Pic.Width
                        Pic.Cut
                    System.Threading.Thread.Sleep(300)
                        Actwb.Sheets("All Pictures").Paste(Actwb.Sheets("All Pictures").Range("A1").Offset(rw,7))
                    System.Threading.Thread.Sleep(300)
                        rw = rw + 10
                    Next Pic
skip_move_image:
                End If
                i = i + 1
            Next sh
            '' display All Pictures sheet
            Actwb.Sheets("All Pictures").Activate
            MsgBox(Prompt:="All images have been transferred to All Pictures sheet.",Title:="My tools")
    End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）