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