2 Star 0 Fork 0

Gitee 极速下载/VBAbox

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
此仓库是为了提升国内下载速度的镜像仓库,每日同步一次。 原始仓库: https://github.com/hongwenjun/vbabox
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
ThisMacroStorage.cls 2.30 KB
一键复制 编辑 原始数据 按行查看 历史
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ThisMacroStorage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
Public sreg As New ShapeRange
Private Sub GlobalMacroStorage_SelectionChange()
On Error GoTo ErrorHandler
Dim n As Long
Dim nr As NodeRange
Dim sh As Shape
If ActiveSelection.Shapes.Count > 0 Then
n = 0
For Each sh In ActiveSelection.Shapes
If sh.Type = cdrCurveShape Then
Set nr = sh.Curve.Selection
n = n + nr.Count
End If
Next sh
If n > 2 Then
LinesForm.Caption = "Nodes: " & n
ElseIf ActiveSelection.Shapes.Count > 1 Then
LinesForm.Caption = "Select: " & ActiveSelection.Shapes.Count
End If
Else
LinesForm.Caption = "LinesForm By Lanya"
End If
If ActiveSelection.Shapes.Count = 1 Then
'// 检测Ctrl:Alt:Shift键状态 17-18-16
If scankey() = 17 Then
If sreg.Exists(ActiveShape) Then sreg.Remove sreg.IndexOf(ActiveShape)
sreg.Add ActiveShape
LinesForm.Caption = "ActiveShape add SREG! Count:" & sreg.Count
End If
If scankey() = 18 Then
sreg.RemoveAll
LinesForm.Caption = "SREG is Removed!"
End If
If scankey() = 16 Then
sreg.CreateSelection
End If
End If
If ActiveSelection.Shapes.Count > 2 And AutoDistribute_Key Then
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
sr.Sort "@shape1.left<@shape2.left"
If first_StaticID <> sr.FirstShape.StaticID Then
Average_Distance
End If
End If
ErrorHandler:
End Sub
Private Function scankey() As Long
Dim ctrlPressed As Boolean
Dim shiftPressed As Boolean
Dim altPressed As Boolean
' 检测Ctrl键的状态 ' 检测Shift键的状态 ' 检测Alt键的状态
ctrlPressed = GetAsyncKeyState(17) And &H8000
shiftPressed = GetAsyncKeyState(16) And &H8000
altPressed = GetAsyncKeyState(18) And &H8000
scankey = 0
If altPressed Then scankey = 18
If shiftPressed Then scankey = 16
If ctrlPressed Then scankey = 17
End Function
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
1
https://gitee.com/mirrors/VBAbox.git
git@gitee.com:mirrors/VBAbox.git
mirrors
VBAbox
VBAbox
main

搜索帮助

A270a887 8829481 3d7a4017 8829481