如何提取表格内容

哈喽哈哈1

1.    Sub 滚动照片()
   
2.     Dim rng As Range
   
3.     Dim imgChart As Chart
   
4.     Dim imgPath As String
   
5.    
   
6.     ' 设置要导出的表格区域
   
7.     Set rng = ThisWorkbook.Sheets("窗体模版").Range("A1:AL431")
   
8.    
   
9.     ' 创建一个临时图表
   
10.     Set imgChart = ThisWorkbook.Charts.Add
    
11.    
    
12.     ' 将表格区域复制到临时图表中
    
13.     rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
14.     With imgChart
    
15.         .Paste
    
16.         ' 修改保存路径为当前工作簿的路径
    
17.         imgPath = ThisWorkbook.Path & "\滚动照片\ExportedImag.jpg"
    
18.         .Export fileName:=imgPath
    
19.         .Delete ' 删除临时图表
    
20.     End With
    
21.    
    
22.     ' 清理剪贴板
    
23.     Application.CutCopyMode = False
    
24.    
    
25.     ' 提示图片已导出
    
26.     MsgBox "图片已导出到 " & imgPath
    
27. End Sub
    

复制代码

各位老师，麻烦帮忙看一下，我的本意是通过代码把每次在表格内查询的信息区域形成照片（格式、内容、字体颜色以及背景都不变）并储存在文件夹内。这个代码只能导出来照片但是照片是空白的。能不能指正一下问题点出在哪里。

哈喽哈哈1

1. Sub 滚动照片()
   
2. Dim rng As Range
   
3. Dim imgChart As Chart
   
4. Dim imgPath As String
   
5. Dim wi As Worksheet
   
6. 
   
7. ' 设置要导出的表格区域
   
8. Set rng = ThisWorkbook.Sheets("窗体模版").Range("A1:AL53")
   
9. 
   
10. ' 创建一个临时图表
    
11. Set imgChart = ThisWorkbook.Charts.Add
    
12. 
    
13. ' 将表格区域复制到临时图表中
    
14. rng.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    
15. 
    
16. ' 尝试使用不同的粘贴方法
    
17. With imgChart
    
18.     ' 尝试直接作为图表的一部分粘贴
    
19.     .ChartArea.Select
    
20.     ActiveSheet.Paste
    
21.    
    
22.     ' 检查图表是否已正确粘贴图像
    
23.     If .Shapes.Count = 0 Then
    
24.         MsgBox "图表没有粘贴任何图像。"
    
25.         GoTo NextStep
    
26.     End If
    
27.    
    
28.     ' 修改保存路径为当前工作簿的路径
    
29.     imgPath = ThisWorkbook.Path & "\滚动照片\ExportedImag.jpg"
    
30.    
    
31.     ' 导出图表为图片
    
32.     On Error Resume Next ' 忽略错误
    
33.     .Export fileName:=imgPath, FilterName:="JPG"
    
34.     If Err.Number <> 0 Then
    
35.         MsgBox "导出图表时发生错误: " & Err.Description
    
36.     End If
    
37.     On Error GoTo 0 ' 恢复正常错误处理
    
38. 
    
39. NextStep:
    
40.     ' 删除临时图表
    
41.     .Delete
    
42. End With
    
43. 
    
44. ' 清理剪贴板
    
45. Application.CutCopyMode = False
    
46. 
    
47. ' 提示图片已导出（如果实际导出了的话）
    
48. If Err.Number = 0 Then
    
49.     MsgBox "图片已导出到 " & imgPath
    
50. Else
    
51.     MsgBox "图片导出失败。"
    
52. End If
    
53. End Sub
    

复制代码

问题已经解决，excel中的内容可以进行复制形成照片并储存在相对应的途径中。

z865593849

试试把图片后缀改成.PNG,其次你的保存区域太大了

taller

哈喽哈哈1

z865593849 发表于 2024-9-27 16:04
试试把图片后缀改成.PNG,其次你的保存区域太大了

区域进行了修改，可是导出来的情况要么就是图表的形式要么就是空白的，这是怎么回事？

哈喽哈哈1

taller 发表于 2024-9-28 04:32

1. 'Dim rng As Range
   
2. 'Dim wsTemp As Worksheet
   
3. 'Dim imgPath As String
   
4. '
   
5. '' 设置要导出的表格区域
   
6. 'Set rng = ThisWorkbook.Sheets("窗体模版").Range("A1:AL41")
   
7. '
   
8. '' 创建一个临时工作表
   
9. 'Set wsTemp = ThisWorkbook.Worksheets.Add
   
10. '
    
11. '' 将表格区域复制到临时工作表中
    
12. 'rng.Copy Destination:=wsTemp.Range("A1")
    
13. '
    
14. '' 修改保存路径为当前工作簿的路径
    
15. 'imgPath = ThisWorkbook.Path & "\滚动照片\ExportedImage.jpg"
    
16. '
    
17. '' 使用工作表的导出功能导出为JPEG图片
    
18. 'wsTemp.ExportAsFixedFormat Type:=xlTypeJPEG, fileName:=imgPath, Quality:=xlQualityStandard
    
19. '
    
20. '' 删除临时工作表
    
21. 'Application.DisplayAlerts = False ' 关闭自动弹出的提示信息
    
22. 'wsTemp.Delete
    
23. 'Application.DisplayAlerts = True ' 恢复自动弹出的提示信息
    
24. '
    
25. '' 清理剪贴板
    
26. 'Application.CutCopyMode = False
    
27. '
    
28. '' 提示图片已导出
    
29. 'MsgBox "图片已导出到 " & imgPath

复制代码

老师，帮忙看一下是哪里有问题。