怎样用VBA把工作表选定区域保存为图片文件

情赌两输

1、想把工作表选定区域保存为图片文件 2、图片文件名以某一单元格内容为名 例：   把A1：C30保存为图片  图片文件名为   A1单元格内容+1           把A31：C60保存为图片 图片文件名为   A1单元格内容+2           把A61：C90保存为图片 图片文件名为   A1单元格内容+3           把A91：C120保存为图片 图片文件名为   A1单元格内容+4 以此类推 Book1.zip (471.86 KB, 下载次数: 222) 2014-12-28 10:30 上传 点击文件名下载附件 谢谢各位大大了

情赌两输

都冬眠了么555555555

香川群子

给你写了个单元格区域内容输出为jpg图片的过程代码，你可以自己修改示例宏代码自己灵活调用。

1. Sub test()
   
2.     Call RangeToPic(Range("A1:D5")) '直接输入要输出的区域……必须有Range()
   
3.     Call RangeToPic(Selection) '按当前选中的区域
   
4.     Call RangeToPic(Application.InputBox("Select Range", Type:=8)) '出现对话框选择区域
   
5. End Sub
   
6. 
   
7. Sub RangeToPic(Rng As Range, Optional Pnm = "", Optional Pth = "")
   
8.     If Pth = "" Then Pth = ActiveWorkbook.Path '默认使用当前文件所在路径作为输出路径
   
9.     If Pnm = "" Then Pnm = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & Replace(Rng.Address(0, 0), ":", "_")
   
10.     '默认使用当前【文件名_区域地址】作为输出文件名
    
11. 
    
12.     If ActiveWindow.DisplayGridlines = True Then ActiveWindow.DisplayGridlines = False: flg = True '去掉默认格子线
    
13.     Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture '把选择范围内容转化为截屏图片信息
    
14.     With ActiveSheet.ChartObjects.Add(0, 0, Rng.Width + 1, Rng.Height + 1).Chart '在A1处按图片尺寸稍大建立1个空白图表对象
    
15.         .ChartArea.Border.LineStyle = 0 '去除边框
    
16.         .Paste '把刚才截屏的图片信息粘贴上去
    
17.         .Export Pth & "" & Pnm & ".jpg", "JPG"  '按指定图片路径及名称导出jgp格式图片……如果区域内有图片应该用这个
    
18.         .Export Pth & "" & Pnm & ".png", "PNG"  '按指定图片路径及名称导出png格式图片……这个对于纯数据工作表来说更好
    
19.         .Parent.Delete '删去该临时增加的图表对象
    
20.     End With
    
21.     If flg Then ActiveWindow.DisplayGridlines = True '恢复默认格子线
    
22. End Sub

复制代码

单元格区域内容输出为jpg图片的过程代码有3个参数，
第1个参数Rng为必需，写入单元格区域地址即可。
第2个参数Pnm为输出图片的名称，默认为【当前工作簿文件名_区域地址】
第3个参数为输出文件夹路径，默认为当前工作簿所在文件夹。


代码更新：
① 为了美观，应该去掉工作表的默认格子线。（如有表格应该自己事先画好格子线）
② 输出增加了png格式……对于纯数据区域来说更节省，但如果区域内含图片则还是用jpg格式较好。

coby001

Rng.CopyPicture xlScreen, xlBitmap

这样，按位图复制，就不会失真了，。

张雄友

coby001 发表于 2014-12-28 13:36
Rng.CopyPicture xlScreen, xlBitmap

这样，按位图复制，就不会失真了，。

Rng.CopyPicture xlScreen, xlBitmap

效果一样的。

coby001

张雄友 发表于 2014-12-28 13:41
Rng.CopyPicture xlScreen, xlBitmap

效果一样的。

把图片贴出来看看

张雄友

coby001 发表于 2014-12-28 13:50
把图片贴出来看看

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

coby001

张雄友 发表于 2014-12-28 13:53
................................

你说失真，，总要有个对比吧
一张图怎么对比？？

张雄友

coby001 发表于 2014-12-28 14:00
你说失真，，总要有个对比吧
一张图怎么对比？？

可能是我电脑问题，表格对象上有少许阴影。

coby001

原始的 第二条竖线被加粗了
按 位图的 就是原样粗细~