求大神帮忙看看怎么修改导出指定单元格为图片的代码

donis2017

很奇怪这段代码运行的时候会报错提示：错误1004，但是多按几次又能成功生成图片
但是生成的图片，最后一张中间对称的两条边框线会变粗，
麻烦大神帮忙看一下，怎么修改，同时能否增加将生成的图片导出为PNG格式，并且以工作簿命名1、2、3....

donis2017

求助大神快来~，这个有点急用

donis2017

发现边框变粗问题，只是放大就不会了。
跪求大神帮忙解决报错和图片导出保存的方法

爱疯

Sub test()
    Dim i
    Application.ScreenUpdating = False
    ActiveSheet.Pictures.Delete

    For i = 2 To Cells(Rows.Count, 2).End(3).Row
        If Trim(Cells(i, 2)) = "小组" Then
            Cells(i, 2).CurrentRegion.CopyPicture
            Call test2
            Cells(i, "J").PasteSpecial
        End If
    Next
    [a1].Select
End Sub

Sub test2()
    Dim aFmts, fmt
    '以数字数组的形式返回剪贴板中当前的格式
    aFmts = Application.ClipboardFormats
    For Each fmt In aFmts
        Debug.Print fmt
    Next
End Sub
测试3.rar (19.38 KB, 下载次数: 1)

2017-2-24 15:46 上传

点击文件名下载附件




都没解决：
1）报错的现象
从帮助中我是没找到有价值的说明。
在我的环境下（32win7+2010）里粘贴前，这么做了后，第1次运行仍报错，但接下来连续执行时，出错的次数少了很多。
2）加粗的边框
这种情况感觉也是没法调整。

donis2017

爱疯 发表于 2017-2-24 16:04
Sub test()
    Dim i
    Application.ScreenUpdating = False

版主也没办法，看来只能放弃了[em19]