求助大神，在目标文件中编写vba代码，汇总ab1 ab2文件中的代码和图片到目标文件中

liucongchaos

求助大神，在目标文件中编写vba代码，汇总ab1 ab2文件中的代码和图片到目标文件中，调整图片尺寸长 2cm 宽 2cm，我写的代码复制图片的时候老是报错，求大神帮忙写一下，谢谢！



Sub CopyImagesFromWorkbooksToAnother()
    Dim targetWorkbook As Workbook
    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim picture As picture
    Dim lastRow As Long
   
    ' 打开目标工作簿
    Set targetWorkbook = ThisWorkbook
   
    ' 指定汇总表
    Set destinationSheet = targetWorkbook.Sheets("sheet1")
   
    ' 图片所在的起始列
    Dim column As Integer
    column = 1 ' B列
   
    ' 文件路径数组，根据需要修改
    Dim workbookPaths As Variant
    workbookPaths = Array("C:\ab1.xlsx", "C:\ab2.xlsx")
   
    ' 遍历所有工作簿路径
    Dim i As Integer
    For i = LBound(workbookPaths) To UBound(workbookPaths)
        ' 打开源工作簿
        Set sourceWorkbook = Workbooks.Open(workbookPaths(i))
        
        ' 设置工作表
        Set sourceSheet = sourceWorkbook.Sheets(1)
        
        ' 检查B2单元格是否有图片
        If Not sourceSheet.Range("B2").Pictures Is Nothing Then
            ' 获取最后一行的行号
            lastRow = destinationSheet.Cells(destinationSheet.Rows.Count, column).End(xlUp).Row
            
            ' 遍历单元格中的所有图片并复制
            For Each picture In sourceSheet.Range("B2").Pictures
                ' 将图片复制到目标工作簿的指定位置
                picture.Copy
                destinationSheet.Cells(lastRow, column).PasteSpecial xlPasteValues
                ' 增加最后一行的行号
                lastRow = lastRow + 1
            Next picture
        End If
        
        ' 关闭源工作簿，不保存更改
        sourceWorkbook.Close SaveChanges:=False
    Next i
   
    ' 关闭目标工作簿，保存更改
    targetWorkbook.Close SaveChanges:=True
End Sub



运行到这里就错误438  
     If Not sourceSheet.Range("B2").Pictures Is Nothing Then

liucongchaos

麻烦来个大神给看看呀

yu3924

dim picture as Shape   不是as Picture
判断是否有图片写  If  sourceSheet.Shapes.Count > 0 then
遍历图片这样写 For Each picture In sourceSheet.Shapes  然后判断picture的类型是否为图片 如果表格只有图片写不写都一样
还有图片写入后，获取最后一行是不变的永远返回第一行 所以自己手动设置行号

liucongchaos

yu3924 发表于 2024-12-16 22:01
dim picture as Shape   不是as Picture
判断是否有图片写  If  sourceSheet.Shapes.Count > 0 then
遍 ...

非常感谢帮忙指正 谢谢