VBA中用copypicture实现表格转图片失败

pan_jianpeng

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

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的范围，如果要指定工作表，可修改工作表名称。

smallppgirl

复制粘贴到微信聊天窗口就可以转图片了

DZHH

之前VBA可以直接将图片嵌入表格，后面我再用vba处理的时候全部变成超链接了，好奇怪

lisongmei

rng.copypicture
set cht=.....   不带chart
cht.activate     #不能连续执行主要是这里，需要加上activate     ，如果cht带chart,好像用 chartarea.select,然后 paste也可以，你自己去试吧。
with  cht.chart
.paste
.export "picture path"
cht.delete

grekevin

[Visual Basic] 纯文本查看 复制代码

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

pan_jianpeng

grekevin 发表于 2024-10-25 12:12
[mw_shl_code=vb,true]Sub 表格转图片()
    '该代码逐步执行正常，但是连续执行得到的图片为空
    Dim  ...

原来是少了个选择的过程，感谢大神！