学习资源:《Excel VBA从入门到进阶》第44集 by兰色幻想
本节来学习如何处理VBA图片与图形处理,用到的是VBA的shape对象。
Shape 对象,该对象代表工作表或图形工作表上的所有图形,它是sheets和chart的子对象(属性)。下表列出shape部分常用属性。
![](https://pic1.zhimg.com/80/v2-2fb78ab7449916211b5d6d3b17fd9e3c_1440w.jpg)
获取单元格sheet.shape.topleftcell.address
使用示例:获取shape的l类型。
Dim ms As Shape
Cells(k, 1) = ms.Type
![](https://pic4.zhimg.com/80/v2-b522e60069e4624ad7f895523ac0f20f_1440w.jpg)
关于shape对象的添加、编辑、变换位置等操作,在这边就略过了。因为这部分内容太多,使用起来也复杂,需要用到时就使用录制宏来获取代码吧。
下面学三段常用的代码:
1. 图片批量导入
例题:在B例批量导入A列名称的对应图片。
![](https://pic1.zhimg.com/80/v2-96a5e5100babe873ee71c65cdb7d713c_1440w.jpg)
![](https://pic1.zhimg.com/80/v2-d65e1179a5c590b525201e743b04e20c_1440w.jpg)
思路:插入图形,在图形上填充图片。
因为部分图片分辨率过大,直接插入,可能会导致文件很大。在图形上插入,可以控制图片的大小,和压缩图片。
提示:关于如何插入图形,可以录制一个插入图形并填充图片的宏,获得代码后再套上循环改写。
Sub 图片导入()
Dim S As Shape
Dim RG As Range
'删除已有图片
For Each S In ActiveSheet.Shapes
If S.Type <> 8 Then '有插入一个窗体控件指定宏
S.Delete '把不是窗体控件的shape(图片、图形等)清除
End If
Next S
'导入图形
For Each RG In Range("B2:B5")
'插入矩形msoShapeRectangle,它的左边距、顶点、宽度、高度都引用RG单元格的
ActiveSheet.Shapes.AddShape(msoShapeRectangle, RG.Left, RG.Top, RG.Width, RG.Height).Select
'RG单元格左边单元格填写了图片名称,填充对应图片到矩形里。
Selection.ShapeRange.Fill.UserPicture "C:" & RG.Offset(0, -1) & ".jpg"
Next RG
End Sub
运行示例(逐步展示导入图片,实际用时其实是一秒多):
![](https://pic1.zhimg.com/v2-ae213fef74def1c95b20ebc945444f44_b.jpg)
2. 批量插入复选框
例题:在B例批量导入复选框。
![](https://pic3.zhimg.com/80/v2-29c6a804e98270b747876e84b9661c76_1440w.jpg)
提示:先录制一个插入复选框的宏,获得代码后再套上循环改写。
Sub 批量插入复选框()
Dim RG As Range
Dim S As Shape
'删除已有复选框
For Each S In ActiveSheet.Shapes
If InStr(S.Name, "Ch") > 0 Then '复选框的名称是Check box
S.Delete
End If
Next S
'批量插入复选框
For Each RG In Range("B2:B15")
'插入复选框CheckBoxes,它的左边距、顶点、宽度、高度都引用RG单元格的
ActiveSheet.CheckBoxes.Add(RG.Left, RG.Top, RG.Width, RG.Height).Select
'复选框的文本为“是”,值为空,链接的单元格是RG的位置
With Selection
.Characters.Text = "是"
.Value = xlOff
.LinkedCell = RG.Address
End With
'把RG单元格的字体颜色变成白色,否则打勾会显示True和False
RG.Font.ThemeColor = xlThemeColorDark1
Next RG
End Sub
运行示例(逐步批量插入复选框,实际用时不过1秒多):
![](https://pic3.zhimg.com/v2-5990a42487a1718fad257df8fd0305de_b.jpg)
3. 连线
例题:把相同内容的单元格连线起来。
Sub 连线()
Dim rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range
Dim S As Shape
Dim RG As Range
'删除已有线条
For Each S In ActiveSheet.Shapes
If S.Type = 9 Then
S.Delete
End If
Next S
'连线
Set rg1 = Range("B1")
Set rg2 = Range("B2")
Set rg3 = Range("C2")
Set rg4 = Range("C1")
'控制起点和终点,起点为B列单元格的左边线中点,终点为C列单元格的左边线中点
'没有右边线的说法,所以不能把起点设为A列单元格的右边线中点
ActiveSheet.Shapes.AddLine(rg1.Left, rg1.Top + rg1.Height / 2, rg3.Left, rg3.Top + rg3.Height / 2).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
ActiveSheet.Shapes.AddLine(rg2.Left, rg2.Top + rg2.Height / 2, rg4.Left, rg4.Top + rg4.Height / 2).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
End Sub
运行示例(逐步进行连线,实际用时不超1秒):
![](https://pic1.zhimg.com/v2-8abbb130a35c2b61cb23666501a4c3bc_b.jpg)
小结
这些例题都比较简单,尤其第三道,只是想把几个可能常用到的实例介绍出来,要想把它们化为己用的话肯定要改写一下,如果需要用到没讲的功能就使用录制宏来获取代码吧,不细讲了~
这几天有看视频的,就是不知道该怎么做笔记了,因为有些内容也没听太明白,后面可能还会慢更(捂脸……让我想想该怎么做之后的笔记会比较好……