VBA中用copypicture实现表格转图片失败
本帖最后由 pan_jianpeng 于 2024-10-25 19:18 编辑6#已解决该问题
用VBA写的代码，如下：
Sub 表格转图片()
'该代码逐步执行正常，但是连续执行得到的图片为空
Dim rng As Range
Dim cht As Chart
'设置保存路径
MyPath = ActiveWorkbook.Path & "\"
Filename = "1.jpg"
myp = MyPath & Filename
'设定需要复制的表格位置
Set rng = Range("A1:K6")
'创建图表
Set cht = ActiveSheet.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top + 100, Width:=rng.Width, Height:=rng.Height).Chart
'复制表格，粘贴为图片，并导出
rng.CopyPicture
With cht
.Paste
.Export myp
.Parent.Delete
End With
End Sub
求大神救救是什么问题？
又或者VBA可以如何将表格中A1:K6的内容，原内容输出另存为图片？
本帖最后由 kingc138 于 2024-10-24 21:01 编辑
Sub ExportRangeToImage()
Dim rng As Range
Dim chartObj As ChartObject
Dim wb As Workbook
Dim imagePath As String
' 设置工作簿和工作表
Set wb = ActiveWorkbook
Set rng = ActiveSheet.Range("A1:K6")
' 设置图片保存路径，使用Excel文件的路径和名称，扩展名为.jpg
imagePath = wb.Path & "\" & wb.Name & "_A1_K6.jpg"
' 复制指定区域，设置为屏幕显示的图片格式
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' 在当前活动工作表中创建一个临时的图表对象
Set chartObj = ActiveSheet.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
' 将复制的区域粘贴到图表中
chartObj.Chart.Paste
chartObj.Chart.Export Filename:=imagePath, FilterName:="JPG"
' 删除临时创建的图表对象
chartObj.Delete
End Sub
这样试试，该代码针对的是活动工作表A1:K6的范围，如果要指定工作表，可修改工作表名称。 复制粘贴到微信聊天窗口就可以转图片了 之前VBA可以直接将图片嵌入表格，后面我再用vba处理的时候全部变成超链接了，好奇怪 rng.copypicture
set cht=..... 不带chart
cht.activate #不能连续执行主要是这里，需要加上activate ，如果cht带chart,好像用 chartarea.select,然后 paste也可以，你自己去试吧。
withcht.chart
.paste
.export "picture path"
cht.delete Sub 表格转图片()
'该代码逐步执行正常，但是连续执行得到的图片为空
Dim rng As Range
Dim cht As Chart
'设置保存路径
MyPath = ActiveWorkbook.Path & "\"
Filename = "1.jpg"
myp = MyPath & Filename
'设定需要复制的表格位置
Set rng = Range("A1:K6")
'创建图表
Set cht = ActiveSheet.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top + 100, Width:=rng.Width, Height:=rng.Height).Chart
'复制表格，粘贴为图片，并导出
rng.CopyPicture
With cht
.Parent.Select
.Paste
.Export myp
.Parent.Delete
End With
End Sub grekevin 发表于 2024-10-25 12:12
Sub 表格转图片()
'该代码逐步执行正常，但是连续执行得到的图片为空
Dim...
原来是少了个选择的过程，感谢大神！
页:
[1]