【方法Faste'作用于对象' Chart'时失败】无法生成图片的问题

Nsp=娜！再来#

请教解决因【方法Faste'作用于对象' Chart'时失败】无法生成图片的问题
我想将以下单元格区域都分别生成图片a1,a2,a3,a4,a5,a6,a7
Sheets("工作表").Range("A1:A11")
Sheets("工作表").Range("A13:A23")
Sheets("工作表").Range("A25:A35")
Sheets("工作表").Range("A37:A47")
Sheets("工作表").Range("A49:A59")
Sheets("工作表").Range("A61:A71")
Sheets("工作表").Range("A73:A88")

运行下面代码时错误' 1004' :
方法Faste'作用于对象' Chart'时失败，
错误代码指向【myChart.Chart.Paste】
工作表<TempSheetForChart>总是无法删除，
尽管我把For i = 1 To 7逐个修改为For i = 1 To 1，For i = 2 To 2，For i = 3 To 3的逐个执行VBA都一样出错，
尽管我生成1张图片后关闭《请教.xlsm》，再执行VBA也一样出错，
恳请帮助。
请教.rar (18.58 KB, 下载次数: 1)

2023-11-16 21:44 上传

点击文件名下载附件

1. Sub 把excel表格单元格区域转化为图片()
   
2.     Dim strPath As String
   
3.     Dim Rng As Range
   
4.     Dim myChart As ChartObject
   
5.     Dim ws As Worksheet
   
6.     ' 设置路径和要复制的区域
   
7.     strPath = ThisWorkbook.Path & ""
   
8.     For i = 1 To 7
   
9.         If i = 1 Then
   
10.             Set Rng = ThisWorkbook.Sheets("工作表").Range("A1:A11")
    
11.         Else
    
12.             If i = 2 Then
    
13.                 Set Rng = ThisWorkbook.Sheets("工作表").Range("A13:A23")
    
14.             Else
    
15.                 If i = 3 Then
    
16.                     Set Rng = ThisWorkbook.Sheets("工作表").Range("A25:A35")
    
17.                 Else
    
18.                     If i = 4 Then
    
19.                         Set Rng = ThisWorkbook.Sheets("工作表").Range("A37:A47")
    
20.                     Else
    
21.                         If i = 5 Then
    
22.                             Set Rng = ThisWorkbook.Sheets("工作表").Range("A49:A59")
    
23.                         Else
    
24.                             If i = 6 Then
    
25.                                 Set Rng = ThisWorkbook.Sheets("工作表").Range("A61:A71")
    
26.                             Else
    
27.                                 If i = 7 Then
    
28.                                     Set Rng = ThisWorkbook.Sheets("工作表").Range("A73:A88")
    
29.                                 Else
    
30.                                     '--------------------
    
31.                                 End If
    
32.                             End If
    
33.                         End If
    
34.                     End If
    
35.                 End If
    
36.             End If
    
37.         End If
    
38.         On Error Resume Next
    
39.         Application.DisplayAlerts = False
    
40.         Sheets("TempSheetForChart").Delete
    
41.         Application.DisplayAlerts = True
    
42.         On Error GoTo 0
    
43.         ' 新建一个工作表来放置临时图表
    
44.         Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
45.         ws.Name = "TempSheetForChart"
    
46.         ' 将区域复制为图片
    
47.         Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
48.         ' 在新工作表中创建图表
    
49.         Set myChart = ws.ChartObjects.Add(Rng.Left, Rng.Top, Rng.Width, Rng.Height)
    
50.         myChart.Chart.Paste
    
51.         ' 设置图表边框为无
    
52.         myChart.Chart.ChartArea.Format.Line.Visible = msoFalse
    
53.         ' 导出图片
    
54.         myChart.Chart.Export Filename:=strPath & "a" & i & ".png", FilterName:="png"
    
55.         ' 删除临时工作表
    
56.         Application.DisplayAlerts = False
    
57.         ws.Delete
    
58.         Application.DisplayAlerts = True
    
59.     Next i
    
60. End Sub
    

复制代码

gwjkkkkk

请参考 。。。

Nsp=娜！再来#

gwjkkkkk 发表于 2023-11-19 08:25
请参考 。。。

非常感谢老师您的帮助和解决了我的问题！
代码如下：

1. Option Explicit
   
2. 
   
3. Sub TEST1()
   
4.     Dim ar, i As Long
   
5.     Dim strFileName As String, strPath As String
   
6.     Dim dWidth As Double, dHeight As Double
   
7.    
   
8.     strPath = ThisWorkbook.Path & ""
   
9.     ar = Array("A1:A11", "A13:A23", "A25:A35", "A37:A47", "A49:A59", "A61:A71", "A73:A88")
   
10.    
    
11.     For i = 0 To UBound(ar)
    
12.         strFileName = strPath & "a" & i + 1 & ".jpg"
    
13.         Range(ar(i)).CopyPicture
    
14.         dWidth = Range(ar(i)).Width
    
15.         dHeight = Range(ar(i)).Height
    
16.         With ActiveSheet.ChartObjects.Add(0, 0, dWidth, dHeight)
    
17.             With .Chart
    
18.                 ' 粘贴图片并设置图表格式以去除边框
    
19.                 .Paste
    
20.                 .ChartArea.Format.Line.Visible = msoFalse ' 确保没有边框
    
21.                 .PlotArea.Format.Line.Visible = msoFalse ' 确保图表内部没有边框
    
22.                 .ChartArea.Fill.Visible = msoFalse ' 去除背景
    
23.                 .PlotArea.Fill.Visible = msoFalse ' 去除图表区域的背景
    
24.                 .Export Filename:=strFileName
    
25.             End With
    
26.             .Delete
    
27.         End With
    
28.     Next i
    
29. 
    
30.     Beep
    
31. End Sub
    

复制代码