- 精华
- 活跃值
-
- 积分
- 1464
- 违规
-
- 印币
-
- 鲜花值
-
- 在线时间
- 小时
累计签到:275 天 连续签到:35 天
|
我也求教deepseek,但是因为我基础差,总是试不成功。
以下是deepseek给出的代码:
Sub SortSelectionOrder()
' 按坐标排序后,调整ActiveSelection的顺序(其他程序可通过此顺序读取)
Dim arr(), i&, j&, s As Shape
ReDim arr(1 To ActiveSelection.Shapes.Count, 1 To 3)
' 提取坐标和对象
i = 1
For Each s In ActiveSelection.Shapes
arr(i, 1) = s.PositionY ' Y优先(从上到下)
arr(i, 2) = s.PositionX ' X其次(从左到右)
Set arr(i, 3) = s ' 对象引用
i = i + 1
Next
' 冒泡排序
For i = 1 To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If (arr(j, 1) < arr(i, 1)) Or _
(arr(j, 1) = arr(i, 1) And arr(j, 2) < arr(i, 2)) Then
Swap arr, i, j
End If
Next
Next
' 输出排序后的对象顺序(供其他程序使用)
For i = 1 To UBound(arr)
Debug.Print "顺序" & i & ": " & arr(i, 3).Name
Next
End Sub
Sub Swap(arr, i, j)
Dim temp(1 To 3)
temp(1) = arr(i, 1): temp(2) = arr(i, 2): Set temp(3) = arr(i, 3)
arr(i, 1) = arr(j, 1): arr(i, 2) = arr(j, 2): Set arr(i, 3) = arr(j, 3)
arr(j, 1) = temp(1): arr(j, 2) = temp(2): Set arr(j, 3) = temp(3)
End Sub |
|