VBA-触类旁通：图形、图片、与表单控件

 

Shapes大家族：

首先认识一下，在VBA里他们都叫shapes

 

 

 示例：计算有多少个shape

Sub test()
MsgBox Sheet1.Shapes.Count
End Sub

shape属性

Sub test()
Dim shp As Shape
For Each shp In Sheet1.Shapes
    i = i + 1
    Range("a" & i) = shp.Name
    Range("b" & i) = shp.TopLeftCell.Address
    Range("c" & i) = shp.Type
Next
End Sub

有上面excel里的图片得到

 

 

 sheet表也有自己的类型

Sub test1()
MsgBox Sheets(2).Type '工作表也有自己的类型
End Sub

删除图片，根据type不同来删除

Sub test()
Dim shp As Shape
For Each shp In Sheet1.Shapes
    If shp.Type = msoPicture Then 'shp.type = 13也行
        shp.Delete
    End If
Next
End Sub

补充说明：在参数里带“[ ]”里面的参数可以不用写，其余的是必须要写的参数

 

 

 按位置插入并调整图片（可以帮助，录制宏来实现，学会自学）

如下图所示，需要导入图片

 

 

 实现代码如下：

Sub test()
Dim i As Integer
Dim shp As Shape
On Error Resume Next
For Each shp In Sheet1.Shapes '删除所有图片，以免越点越多
    shp.Delete
Next
For i = 2 To 12
    Sheet1.Shapes.AddPicture "d:\data\" & Range("a" & i) & ".jpg", msoFalse, msoTrue, Range("d" & i).Left, Range("d" & i).Top, Range("d" & i).Width, Range("d" & i).Height
Next
End Sub

更进一步自动化：使图片大小跟着单元格的大小变而变，通过录制宏实现，学习

Sub test()
Dim i As Integer
Dim shp As Shape
Dim shp1 As Shape
On Error Resume Next
For Each shp In Sheet1.Shapes '删除所有图片，以免越点越多
    shp.Delete
Next
For i = 2 To 12
    Set shp1 = Sheet1.Shapes.AddPicture("d:\data\" & Range("a" & i) & ".jpg", msoFalse, msoTrue, Range("d" & i).Left, Range("d" & i).Top, Range("d" & i).Width, Range("d" & i).Height)
    shp1.Placement = xlMoveAndSize
Next
End Sub

改文件名

VBA里对文件改名方式如下 :name  .....  as ......

Sub test1()
Name "d:\data\汪梅.jpg" As "d:\data\汪梅123.jpg"
End Sub

如下根据excel表中的数据对图片就行改名

 

 

 代码如下：

Sub test()
Dim i As Integer
On Error Resume Next
For i = 2 To 12
   Name "d:\data\" & Range("a" & i) & ".jpg" As "d:\data\" & Range("a" & i) & Range("d" & i) & ".jpg"
Next
End Sub

图表对象：通过录制宏来实现

             实现

 代码如下：

Sub test()
Dim shp As Shape

Set shp = Sheet1.Shapes.AddChart2
    shp.Chart.SetSourceData Range("b2:c14")  '数据源
    shp.Chart.ChartType = xlLine    '设置柱形图还是折线等图形
    shp.Chart.Axes(xlValue).MinimumScale = 1000000 '设置纵坐标区间

End Sub

使用表单控件

表单控件比ActiveX控件节省内存，简单，灵活

    通过分组框来使两道题的单选互斥

 

 

有分组框影响美观，那么怎么隐藏呢，在分组框属性里，他是没有这个隐藏功能的，所以无法录制来实现，靠猜来实现，触类旁通

 

Sub test()
Dim shp As Shape
'寻找表单控件的差别
For Each shp In Sheet1.Shapes
    i = i + 1
    Range("g" & i) = shp.Name
   ' range("g"& i) = shp.type
Next
End Sub
-----------------------------
Sub test1()
Dim shp As Shape

For Each shp In Sheet1.Shapes
    'If shp.Name = "Group Box*" Then  这样写没有效果，=必须是精准的名字
    If shp.Name Like "Group Box*" Then
        shp.Visible = msoFalse
    End If
Next
End Sub

 

也可以这样

Sub test1()
Dim shp As Shape

For Each shp In Sheet1.Shapes
    If shp.FormControlType = xlGroupBox Then
        shp.Visible = msoFalse
    End If
Next
End Sub

like运算符

 

 

 里面的字符代表的意思需要记住

Sub test()
Dim i As Integer
Range("a2:a15").Interior.Pattern = xlNone

For i = 2 To 15
    'If Range("a" & i) Like "J*" Then '"J??????"  "J???w???"
    'If Range("a" & i) Like "[A-M a-m]*" Then 代表以字母开头的
    'If Range("a" & i) Like "[0-9]*" Then  '或者可以 "#*";"##*"#代表一个数字
    'If Range("a" & i) Like "[0-9][!0-9]*" Then '!感叹号代表是 “非”的意思
    'If Range("a" & i) Like "J???[A-Z a-z]??" Then
    
    
    
        Range("a" & i).Interior.Color = 65535
        'Range("a" & i).Font.Color = 65535
        k = k + 1
    End If
Next
Range("e1") = k
End Sub