Code
myShape.AutoShapeType
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Cells.ColumnWidth = 2
Cells.RowHeight = 13.8 * 150 / 138
Dim myShape As Shape
Dim L_Top As Long
Dim L_Left As Long
L_Top = (Range("a1").Offset(100, 100).Top - Range("a1").Top) / 100
L_Left = (Range("a1").Offset(100, 100).Left - Range("a1").Left) / 100
Dim TheResult As Boolean
For Each myShape In ActiveSheet.Shapes
TheResult = False
TheResult = TheResult Or (myShape.AutoShapeType = 5) '圆角矩形
TheResult = TheResult Or (myShape.AutoShapeType = 7) '三角形
TheResult = TheResult Or (myShape.AutoShapeType = 33) '向右箭头填充
TheResult = TheResult Or (myShape.AutoShapeType = 9) '椭圆
If TheResult Then
myShape.Top = Int(myShape.Top / L_Top) * L_Top
myShape.Left = Int(myShape.Left / L_Left) * L_Left
'一定是先 移动 然后改变 Shape 大小
myShape.Width = Int(myShape.Width / L_Left) * L_Left
myShape.Height = Int(myShape.Height / L_Top) * L_Top
End If
Next
If Target.Address = Range("a1").Address Then
Range("a2").Select
For Each myShape In ActiveSheet.Shapes
If myShape.AutoShapeType = 5 Then '圆角矩形
ElseIf myShape.AutoShapeType = -2 Then '细小箭头
ElseIf myShape.AutoShapeType = 7 Then '三角形
ElseIf myShape.AutoShapeType = 33 Then '向右箭头填充
ElseIf myShape.AutoShapeType = 9 Then '椭圆
Else
myShape.Select
MsgBox myShape.AutoShapeType
End If
Next
End If
ActiveWindow.DisplayGridlines = (Range("a2").Value = "")
Application.EnableEvents = True
End Sub
Code
重点
<?xml version="1.0" encoding="UTF-8" standalone="no"?>