如何复制保存为jpg文件

sampsonpon

1、首先判断R列非空行号

2、复制R1:AJ?(?是第一条的非空行号)内容
3、作为图像保存到同一路径下LT23.jpg文件里，每次覆盖保存

gwjkkkkk

Option Explicit

Sub TEST1()
    Dim r&, strFileName$, strPath$, dWidth#, dHeight#
   
    strPath = ThisWorkbook.Path & "\"
    r = Cells(Rows.Count, "R").End(xlUp).Row
    With Range("R1:AJ" & r)
        strFileName = strPath & "LT23.jpg"
        .CopyPicture
        dWidth = .Width
        dHeight = .Height
        With ActiveSheet.ChartObjects.Add(0, 0, dWidth, dHeight)
            With .Chart
                .Paste
                .ChartArea.Format.Line.Visible = msoFalse
                .PlotArea.Format.Line.Visible = msoFalse
                .ChartArea.Fill.Visible = msoFalse
                .PlotArea.Fill.Visible = msoFalse
                .Export Filename:=strFileName
            End With
            .Delete
        End With
    End With

    Beep
End Sub

gwjkkkkk

..............

sampsonpon

gwjkkkkk 发表于 2024-7-8 19:02
..............

能正常顺利运行直到最后一声Bing响声，但是，LT23.jpg文件里是无图像、一片空白，如下图


运行后，我Ctril+V后发现确实有COPY后的内容，如下图

gwjkkkkk

sampsonpon 发表于 2024-7-9 09:00
能正常顺利运行直到最后一声Bing响声，但是，LT23.jpg文件里是无图像、一片空白，如下图

我这里测试没问题啊 ！

可乐的乐

sampsonpon 发表于 2024-7-9 09:00
能正常顺利运行直到最后一声Bing响声，但是，LT23.jpg文件里是无图像、一片空白，如下图

.Paste上面加个 .Parent.Select看看

sampsonpon

可乐的乐 发表于 2024-7-10 14:32
.Paste上面加个 .Parent.Select看看

还真是这么回事，一加就准，可以了。谢谢您！

sampsonpon

可乐的乐 发表于 2024-7-10 14:32
.Paste上面加个 .Parent.Select看看

测试单独运行时无任何问题，一Call它就出幺蛾子了，LT23.jpg里完全空白

sampsonpon

gwjkkkkk 发表于 2024-7-9 18:29
我这里测试没问题啊 ！

测试单独运行时无任何问题，一Call它就出幺蛾子了，LT23.jpg里完全空白