国庆惊喜大促狂欢大放价
23门原创教程,原价168,限时87元!!
国庆狂欢,优惠不等人,早买早便宜
点击了解
支持微信公众号+小程序+APP+PC网站多平台学习
“听说公司新来个漂亮的妹纸好像叫雨夜,她很喜欢Excel,也特别爱学习,要不要把她拉到你的团队里培养一下?”土豆哥对着企鹅妹说道。
“先考验一下再说吧!”企鹅妹面无表情的说着
领导罗:“雨夜,你把这个Excel文件里的图片按照原尺寸(有些图片已经变形了)弄到电脑里,后天上班要交给我!”。
雨夜打开文件一看,脸上露出了难过的表情,不是因为图片已经变形了,而是这图片也太多了点吧,2555个,为什么不是555个呢,最起码还能大声的55555一场。
看一下数据情况图:
真是越看越想哭,这么多,得弄到啥时候啊?
“我说,这事儿是你安排的吧?”远处的土豆哥对着企鹅妹说。
“我像那么无聊又多事儿的人吗?”说完企鹅妹就往雨夜的方向走了过去,看到雨夜那难过的表情,关切的问道:“遇到什么难题了,让我看看能帮你吗?”
“喏“,雨夜有气无力的用手指了指领导罗给她的文件,小声的说着:“2555个图片,真不知道是那个BT弄出来的,这要导出来得搞到什么时候啊!”
企鹅妹听着,心想:“真是个好领导啊!”,然后眉头一紧说:“嗯,看起来还是有迹可寻的,要不你先起来,让我试试?”
雨夜起身,把位置让给了企鹅妹,只见企鹅妹在键盘上 啪啪啪 的敲了起来,大概10分钟后,企鹅妹手停了,背靠在椅子上,闭着眼睛流露出微笑的表表情,轻轻的点着头,像是在想什么又像是在休息一般!几分钟后屏幕上弹出个提示框!
雨夜一看,惊讶的说:“这是什么意思?”
企鹅妹睁开眼睛,打开保存的文件夹,看了一下文件数量,嗯,数量是对的,应该是完成了。
雨夜问:“企鹅姐姐,您是怎么做到的,才10多分钟就搞定了?能教教我吗?”
企鹅妹说:这是用vba写的程序,代码在这里,里面都有注释(解释),代码在这儿!
代码
'注意得是,程序执行一次后,图片得原始尺寸被代码更改了,再执行就会图片变形了 Sub save_pic() Dim p As Shape, ph As Single, pw As Single, pn As String Dim ph1 As Single, pw1 As Single, n As Integer, p1 As ChartObject Dim fileName As String, t t = Timer '记录开始时间 '当前工作簿下面建立一个导出图片文件夹 fileName = ThisWorkbook.Path & "导出图片1" If Dir(fileName, vbDirectory) = "" Then MkDir (fileName) For Each p In ActiveSheet.Shapes 'type属性查看p得格式,8表示控件格式,不是控件格式才执行 If p.Type <> 8 Then n = n + 1 '记录数量 '记录图片左上角单元格偏移5列单元格值 pn = p.TopLeftCell.Offset(0, -5).Value ph1 = p.Height '记录当前图片尺寸 pw1 = p.Width '原始尺寸,msotrue是图片原始尺寸放大 p.ScaleHeight 1, msoTrue, msoScaleFromTopLeft ph = p.Height '记录放大后的尺寸 pw = p.Width On Error Resume Next '遇到错误强制执行 p.CopyPicture '复制 图片 '创建一个相同尺寸的chartobject对象 Set p1 = ActiveSheet.ChartObjects.Add(0, 0, pw, ph) p1.Select '2010版本以上如果没这句导出会成为空白图片 With p1.Chart .Paste '粘贴 '在当前文件路径下保存为png图片 .Export fileName & "" & pn & ".png", "png" .Parent.Delete '删除 End With '不锁定纵横比 p.DrawingObject.ShapeRange.LockAspectRatio = False p.Width = pw1 '调整回来原来尺寸 p.Height = ph1 End If Next p = Nothing '清空2个对象 p1 = Nothing MsgBox "共成功导出" & n & "张图片,共耗时:" & _ Format(Timer - t, "0.00秒"), vbOKOnly, "导出图片" End Sub |
若是你看不懂又想学的话,就得先去学一下基础,了解一下再来看了。
不过这个文件可得自己保存好,同样的事情我可不想做第二次。
说完企鹅妹便起身准备离开,回头对那还没回过神来的雨夜说了句:“若是你真学vba了,遇到任何问题都可以来找我。”说完随手扔了个小册子就不见了踪影。
雨夜打开小册子认真的看了起来,册子里的内容如下:
详细解释
• 创建文件夹
fileName = ThisWorkbook.Path & "导出图片1" If Dir(fileName, vbDirectory) = "" Then MkDir (fileName) |
Dir函数参中参数
fileName 用来表示搜索路径
vbDirectory用来指定目录或文件夹以及不带属性的文件。
如果不存在该路径或不带属性的文件就返回空,MkDir是根据路径(地址)直接创建文件夹
如果【导出图片1】文件夹不存在就创建一个,存在就下一步
• Type解释
常用得Type格式
名称 | 值 | 说明 |
msoAutoShape | 1 | 自选图形。 |
msoCallout | 2 | 标注。 |
msoCanvas | 20 | 画布。 |
msoChart | 3 | 图。 |
msoComment | 4 | 批注。 |
msoDiagram | 21 | 图表。 |
msoEmbeddedOLEObject | 7 | 嵌入的 OLE 对象。 |
msoFormControl | 8 | 窗体控件。 |
msoFreeform | 5 | 任意多边形。 |
msoGroup | 6 | 组合。 |
msoIgxGraphic | 24 | SmartArt 图形 |
msoInk | 22 | 墨迹。 |
msoInkComment | 23 | 墨迹批注。 |
msoLine | 9 | 线条。 |
msoLinkedOLEObject | 10 | 链接 OLE 对象。 |
msoLinkedPicture | 11 | 链接图片。 |
msoMedia | 16 | 媒体。 |
msoOLEControlObject | 12 | OLE 控件对象。 |
msoPicture | 13 | 图片。 |
msoPlaceholder | 14 | 占位符。 |
msoScriptAnchor | 18 | 脚本定位标记。 |
msoShapeTypeMixed | -2 | 混和形状类型。 |
msoTable | 19 | 表。 |
msoTextBox | 17 | 文本框。 |
msoTextEffect | 15 | 文本效果。 |
• Shape常用属性
.Height 表示图片得高度
.Width 表示图片得宽度
.TopLeftCell 表示图表左上角单元格
这个属性比较常用,如果判断所在得行就是.TopLeftCell.Row
.CopyPicture 复制图片
• ScalaHeight属性解释
按照比例调整图片尺寸
方法:ScalaHeight Factor, RelativeToOriginalSize, Scale
这里是按照原始尺寸放大
• 创建ChartObjects解释
Set p1 = ActiveSheet.ChartObjects.Add(0, 0, pw, ph)
Add后面参数是,左、上、宽度、高度
这里左边距离用0,上面距离也是0,宽度和高度用放大后图片尺寸
p1.Select '2010版本以上如果没这句导出会成为空白图片 With p1.Chart .Paste '粘贴 '在当前文件路径下保存为png图片 .Export fileName & "" & pn & ".png", "png" .Parent.Delete '删除 End With |
这里创建一个空白得Chart对象,因为这个对象有另存为文件得属性,利用这个把图片复制到Chart上保存出去
P1.select 是容错代码,防止2010以上版本office保存出去空白图片问题
原始文件地址(因为原始文件涉及公司机密,文件改为只有10行得精简版本)
链接:https://pan.baidu.com/s/131ITQrCP8bqXa-D7mvi-nw
提取码:shxe
“都说看着枯燥的东西容易犯困,雨夜却没看得津津有味的,似乎她已经找到了修炼这技能的方法,你就不怕她自学成才?”一旁的土豆哥对着企鹅妹说道。
“都是过来人,这条路有那么好走吗?身边有这么强劲的师父她要轻易放过了,损失的又不是我。”企鹅妹淡淡的说着。
“哈哈哈哈,走吧吃饭去,今天晚上吃啥?”土豆哥说道
“随便,反正你掏钱!”企鹅妹说
“那我去买两桶泡面”,话音刚刚落,土豆哥就不见了身影。
未完待续......
今天的分享就到这,如果教程对大家有用,希望大家多多分享点赞支持小编哦!你的每一次点赞和转发都是支持小篇坚持原创的动力。
推荐学习★★★★★
请扫码下载O(∩_∩)O哈哈~