Sub cleanlines()
Dim num, i, k
Dim asg As Object
Dim shparray() As Variant
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With ActiveSheet.Shapes
If .Count < 1 Then
MsgBox "无直线图形！"
Exit Sub
End If
num = .Count
k = 1
ReDim autoshparray(1 To num)
For i = 1 To num
If .Item(i).Type = msoLine Then
dic.Add k, .Item(i).Name
k = k + 1
End If
Next
ReDim Preserve shparray(1 To k - 1)
shparray = dic.items
Set asg = .Range(shparray)
MsgBox asg.Count
asg.Delete
End With
