如何通过点击一个控件按钮批量选择多个单元格并保存至图片至本地文件夹？

atxiaoli

各位好！
现在遇到了一个问题，
即：
需要通过点击一个按钮的形式，将：单元格 D6 到 G9  这一片区域的单元格  全部选中（需求1）。
之后将该区域单元格内的内容复制成图片（需求2），并将该图片保存至本地某个文件夹中（需求3）。

保存为图片功能.rar (17.02 KB, 下载次数: 8)

2020-3-26 13:36 上传

点击文件名下载附件

目前在网上找到了一个可以实现类似功能的代码（如下），但该代码1无法将单元格中的内容保存出来，2所能保存出来的图片只能显示其中某一格空白的单元格。

还请各位大牛指点迷津，需求1，2，3中无论是部分知晓还是全部知晓，还望不吝赐教，谢谢！

网上找到的类似功能的代码：

• Sub test()
• Dim Newshape As Shape
•     Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
•     ActiveSheet.Paste
•      Set Newshape = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
•      With ActiveSheet.ChartObjects.Add(1, 1, 1, 1)
•          .Width = Newshape.Width
•          .Height = Newshape.Height
•           Newshape.Copy
•          .Chart.Paste
•          .Chart.Export ActiveWorkbook.Path & "\Myjpg.jpg"
•          .Delete
•      End With
•      Newshape.Delete
•    MsgBox "恭喜!图片已生成并存放在" & ActiveWorkbook.Path
• End Sub
• 
  

larer

你找到的代码没有问题,,不存在你说的无法将内容保存出来和只显示其中某一格的问题.

atxiaoli

larer 发表于 2020-3-26 13:28
你找到的代码没有问题,,不存在你说的无法将内容保存出来和只显示其中某一格的问题.

你好，我更新了一下附件，把那段代码加进去了，但是一个是如果不手动选择单元格范围，则默认只会转换1个单元格为图片并保存在本地，但单元格里面的内容在图片里是没有显示的。另外就是如果手动选择了单元格范围，按点击按钮，则可以将选中的单元格范围以图片形式保留到本地，但是单元格里面的内容，图片里是没有的。

魂断蓝桥

Sub a()
Dim ran As Range
    Application.DisplayAlerts = False
    Set ran = [d6:g9]
    ran.Select
    ran.CopyPicture
    With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
        .Paste
        .Export ActiveWorkbook.Path & "\Myjpg.jpg"
        .Parent.Delete
    End With
    Application.DisplayAlerts = True
    MsgBox ("OK")
End Sub

atxiaoli

魂断蓝桥 发表于 2020-3-26 13:51
Sub a()
Dim ran As Range
    Application.DisplayAlerts = False

你好，非常感谢，功能基本都实现了，但有一个问题，就是保存到本地的图片是一片白，单元格内的数据，底纹之类的都没有，不知是否是版本的原因还是什么？我现在用的是win10自动升级后附带成的office2019

大萝卜白菜

atxiaoli 发表于 2020-3-26 14:12
你好，非常感谢，功能基本都实现了，但有一个问题，就是保存到本地的图片是一片白，单元格内的数据，底纹 ...

在.Paste 前插入一句.Parent.Select

atxiaoli

大萝卜白菜 发表于 2020-3-26 15:03
在.Paste 前插入一句.Parent.Select

你好，可以了，非常感谢！

另外，额外的想请教一下，保存出来的图片的文件名能不能用某单元格（比如用来填写 姓名 的 A1单元格）的值来定？ 这样保存出来的图片就更方便了，不需要每次都重命名。

atxiaoli

感谢：魂断蓝桥 与 大萝卜白菜 两位大牛的的帮助。
目前三个需求都已全部实现。现贴出完整代码，供有需要的日查阅使用。


Sub a()
Dim ran As Range
    Application.DisplayAlerts = False
    Set ran = [d6:g9] ’所需选取的单元格范围
    ran.Select
    ran.CopyPicture
    With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
        .Parent.Select
        .Paste
        .Export ActiveWorkbook.Path & "\Myjpg.jpg"
        .Parent.Delete
    End With
    Application.DisplayAlerts = True
    MsgBox ("OK") '感谢 excelhome的：魂断蓝桥 与 大萝卜白菜 两位大牛的帮助！
End Sub

大萝卜白菜

atxiaoli 发表于 2020-3-26 15:15
你好，可以了，非常感谢！

另外，额外的想请教一下，保存出来的图片的文件名能不能用某单元格（比如用 ...

可以，.export activeworkbook那句自行拼接上单元格就行

atxiaoli

大萝卜白菜 发表于 2020-3-26 15:29
可以，.export activeworkbook那句自行拼接上单元格就行

完全可以了，非常感谢花时间的细心帮助，谢谢！