将 Excel 表格另存为文件夹中的图片 - 应用程序定义或对象定义错误

如何解决将 Excel 表格另存为文件夹中的图片 - 应用程序定义或对象定义错误

我从 Excel 电子表格中获取数据并通过邮件合并填充 Word 文档。主宏的目标是将多个 Excel 表格以 jpg 格式保存到特定文件夹。

主宏将执行以下操作：

1. 从同一个 Excel 文件中的多个 Excel 工作表中获取各种 Excel 表格（命名范围为 TABLE1、TABLE2 等），并确定是否需要该表格
2. 复制 Excel 表格并将其作为图片粘贴到 Excel 单元格上
3. 创建一个临时图表并使用第 2 步中的图片来填充图表
4. 使用所需图片名称将图表导出为所需文件夹中的 .jpg 文件
5. 删除第 2 步和第 3 步中的临时图表和图片
6. 对所有表重复

该宏通常有效，并且是最终宏的一部分，该宏为最终邮件合并组合了其他宏。

问题

在线Sh.copyPicture，我得到

运行时错误“1004”应用程序定义或对象定义错误。

一切正常，直到行 tmpChart.ChartArea.Width = Sh.Width 和 tmpChart.ChartArea.Height = Sh.Height 没有返回预期的结果。图表的尺寸应该和图片一样，但在宏观上它们要小得多。

Sub SelectedRangetoImage()
Dim tmpChart As Chart,n As Long,shCount As Long,sht As Worksheet,Sh As Shape,rng As Range
Dim fileSaveName As Variant,pic As Variant
Dim strFolders As String
Dim i As Integer
    
strFolders = Application.ThisWorkbook.Path
strFolders = strFolders & "\" & "TablesPictures"
Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    
i = 1
Do Until i > 4    'Below are conditions to run only relevant tables
    
    If (i = 1 And Range("Show_Table1").Value = "No") Or (i = 2 And Range("Show_Table2").Value = "No") _
      Or (i = 3 And Range("Show_Table3").Value = "No") Or (i = 4 And Range("Show_Table4").Value = "No") Then
        i = i + 1
       
    Else
    
        Application.Goto Reference:="TABLE" & i
    
        ActiveWindow.Zoom = 300                        'Very important to zoom,otherwise the pictures are blurry
    
        'Create temporary chart as canvas
        Set sht = ActiveSheet
        Set rng = sht.Range("Table" & i)
        rng.copyPicture

        With sht.Pictures.Paste
        End With
    
        Set Sh = sht.Shapes(sht.Shapes.Count)
        Set tmpChart = Charts.Add
        tmpChart.ChartArea.Clear
        tmpChart.Name = "PicChart" & (Rnd() * 10000)
        Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject,Name:=sht.Name)
        tmpChart.ChartArea.Width = Sh.Width
        tmpChart.ChartArea.Height = Sh.Height
        tmpChart.Parent.Border.Linestyle = 0
    
        'Paste range as image to chart
        
        Sh.copyPicture    'HERE IS THE ERROR MESSAGE
    
        With tmpChart.Pictures.Paste
        End With
    
        tmpChart.Export Filename:=strFolders & "\" & "Table" & i & ".jpg",Filtername:="JPG"
           
        'Clean up
        sht.Cells(1,1).Activate
        sht.ChartObjects(sht.ChartObjects.Count).Delete
        Sh.Delete

        ActiveWindow.Zoom = 115
    
        i = i + 1
    End If
    
Loop
End Sub