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