Question

这个问题可能与此有关：

Copy image from one workbook to another workbook

但是它有不同的方法。

我的目标是使用图像ID将图像从当前工作簿复制到另一个工作簿。基本上，如果我们粘贴图像，则该对象称为“ Picture2”，“ Picture3”，“ Picture4”等。

在这种情况下，我试图为这些名称设置通用代码。

我的整个代码如下：

 Sub Splicing()
  Dim PoP As String, SN As String
  Dim name As String, name2 As String, custom_name As String
  Dim Fibre As Variant
  Dim shp As Shape


  Dim newbook As Workbook
  Dim fs As Worksheet

  Set fw = Sheets("Frontsheet")
 'name = fw.Range("AA9")
  name = fw.Range("D18")
  name2 = fw.Range("D38")
  custom_name = name & " - Splicing As-build_v." & name2 & ".0"

  PoP = ActiveWorkbook.Sheets("Frontsheet").Range("D10").Value
  SN = ActiveWorkbook.Sheets("Frontsheet").Range("D12").Value


  Fibre = ThisWorkbook.Sheets("Fibre Drop Release Sheet").Range("A2:H20")

  Path = ActiveWorkbook.Path & "\Splicing Template_V1.0.xlsm"
  Set newbook = Workbooks.Open(Path)

  newbook.Sheets("Frontsheet").Cells(10, 4).Value = PoP
  newbook.Sheets("Frontsheet").Cells(12, 4).Value = SN


  newbook.Sheets("Fibre drop release sheet").Range("B3:H20").Value = Fibre

   ' COPYING THE PICTURE

  For Each shp In ActiveWorkbook.Shapes
  If shp.name Like "*Picture*" Then
    If Not Intersect(shp.TopLeftCell, rng) Is Nothing Then
    shp.Copy
    Application.Goto newbook.Sheets("Locality").Range("A6")

    Rows(6).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 


    Workbooks(Path).Sheets("Locality").Paste
    End If
  End If
  Next shp

 ' END OF THE CODE WITH COPYING THE PICTURE


  Path = ActiveWorkbook.Path & "\" & custom_name & ".xlsm"

 'Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs filename:=Path, FileFormat:=52


  End Sub

我从这里修改了部分代码

https://www.ozgrid.com/forum/index.php?thread/149244-copy-image-from-one-workbook-to-another-workbook/

为什么我的调试器说，For Each ship in ActiveWorkbook.Shapes下的**对象不支持此方法**？

如何调整此代码以使其运行？

Answer 1

我的正确代码应如下所示：

 Sub Splicing()
   Dim PoP As String, SN As String
   Dim name As String, name2 As String, custom_name As String
   Dim Fibre As Variant
   Dim shp As Shape


   Dim newbook As Workbook
   Dim fs As Worksheet, ls as Worksheet   'Dim my another source sheet

   Set fw = Sheets("Frontsheet")
   Set ls = Sheets("Location") ' Setting new worksheet in our document

   name = fw.Range("D18")
   name2 = fw.Range("D38")
   custom_name = name & " - Splicing As-build_v." & name2 & ".0"

   PoP = ActiveWorkbook.Sheets("Frontsheet").Range("D10").Value
   SN = ActiveWorkbook.Sheets("Frontsheet").Range("D12").Value


   Fibre = ThisWorkbook.Sheets("Fibre Drop Release Sheet").Range("A2:H20")

   Path = ActiveWorkbook.Path & "\Splicing Template_V1.0.xlsm"
   Set newbook = Workbooks.Open(Path)

   newbook.Sheets("Frontsheet").Cells(10, 4).Value = PoP
   newbook.Sheets("Frontsheet").Cells(12, 4).Value = SN


   newbook.Sheets("Fibre drop release sheet").Range("B3:H20").Value = Fibre

  ' COPYING THE PICTURE

  For Each shp In ls.Shapes  ' We are changing "Workbook" to the Worksheet set above
  If shp.name Like "*Picture*" Then
  shp.Copy
  Application.Goto newbook.Sheets("Locality").Range("A6")

  newbook.Sheets("Locality").Paste
  End If
  Next shp

  ' END OF THE CODE WITH COPYING THE PICTURE


  Path = ActiveWorkbook.Path & "\" & custom_name & ".xlsm"

 'Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs filename:=Path, FileFormat:=52


  End Sub

基本上，这是For Each语句的简单实现。我们不是复制具有指定名称的图像，而是复制具有潜在名称的图像，该图像与我们的通配符相匹配。

VBA Excel将图像从活动工作簿复制到另一个工作簿

1 个答案: