UI独立图片，工具栏三个皮肤，鼠标悬停五彩斑斓的黑

README.md

@@ -1,33 +1,72 @@
+### [捐赠 蘭雅CorelVBA工具 开源软件](https://github.com/hongwenjun/corelvba/blob/main/donate.md)
 # [CorelDRAW VBA](https://262235.xyz/index.php/tag/vba/)
 ![](https://262235.xyz/usr/uploads/2022/03/525753621.webp)
 
-## 蘭雅CorelVBA工具箱  0520完整版下载
-### https://262235.xyz/262235_GMS_0520.7z
+# [蘭雅CorelVBA工具-中秋版 将奉送价值上千多款定置插件](https://262235.xyz/index.php/archives/1124/)
 
-## 蘭雅CorelVBA工具箱工具栏UI功能导图 
-![](https://262235.xyz/usr/uploads/2022/05/756737974.jpg)
+## 蘭雅CorelVBA工具中秋版 修复更新和添加的主要功能
 
-
-## 蘭雅CorelVBA工具箱 安装方法
-------------------------------------------------
 ```
-├─Addons
-│  └─Draw
-│      └─262235.xyz
-└─GMS
-    └─262235.xyz
+* 8215267 (HEAD -> main, origin/main, origin/HEAD) 蘭雅CorelVBA工具 UI独立图片 添加语音功能提示
+* 1457811 蘭雅CorelVBA工具-中秋版 更换UI图
+* 0f35182 简单一刀切_识别群组由群友宏瑞广告赞助发行
+* b2eb2c4 一键智能群组--功能由群友半缘君赞助发行
+* ae14f4f 一键智能拆字功能更新
+* 71bc9a1 添加功能: Adobe_Illustrator复制粘贴互转  标记画框  一键智能拆字 拆分线段
+* aeb8074 Create donate.md
+* 32649bf 修改颜色条注册表控制
+* c568449 2022-08更新添加设置保存注册表
+* 177b9d6 更新完整功能
+* bdce822 Create Export_JPEG_Link.bas
+* b1cd302 CorelDRAW X6 64位 支持移动窗口
+* 17cb37e 蘭雅CorelVBA工具箱 0520完整版源码更新
+
 ```
--------------------------------------------
 
-## GMS 文件夹的文件 复制到 
-- C:\\Program Files (x86)\\Corel\\CorelDRAW Graphics Suite X4\\Draw\\GMS
+## 蘭雅CorelVBA工具 UI独立图片，工具栏三个皮肤，鼠标悬停五彩斑斓的黑
 
-## Addons 文件夹的文件 复制到 
-- C:\\Program Files (x86)\\Corel\\CorelDRAW Graphics Suite X4\\Programs\\Addons
+![](https://262235.xyz/usr/uploads/2022/09/3673480311.webp)
 
---------------------------------------------
+## 新合并工具: 多页合并一页工具
+
+![](https://262235.xyz/CorelVBA/UniteOne.gif)
+
+## 批量排序升级,自由设置间隔
+
+![](https://262235.xyz/CorelVBA/left_top_align.gif)
+
+## 自用拼版角线功能完善，欢迎大家白嫖
+
+![](https://262235.xyz/CorelVBA/jxpb.gif)
+
+## 修复更新 `CorelDRAW和Adobe Illustrator剪贴板交换数据` 支持 CorelDRAW X4-2022 版本
+
+  * 网友评价，文字复制不会乱码，比其他同类插件强，可以当收费插件  
+![](https://262235.xyz/CorelVBA/Adobe_Illustrator.gif)
 
-## VBA工具支持 CorelDRAW X4 和 以上版本，安装方法可能有稍微不同
+## 一键智能拆字功能由群友半缘君赞助发行
+
+![](https://262235.xyz/CorelVBA/onekey_cai.gif)
+
+## 简单一刀切_识别群组由群友宏瑞广告赞助发行
+
+![](https://262235.xyz/CorelVBA/dollar_cut.gif)
+
+## 蘭雅CorelVBA工具-中秋版 奉送价值上千元多款定置插件
+
+![CorelVBA_Moon.webp](https://262235.xyz/usr/uploads/2022/08/77746067.webp)
+
+本原创文章自由转载,转载请注明本博来源及网址 | 当前页面：[蘭雅sRGB 个人笔记](https://262235.xyz/) 
+[蘭雅CorelVBA工具-中秋版 将奉送价值上千多款定置插件](https://262235.xyz/index.php/archives/1124/)
+
+标签：[vba](https://262235.xyz/index.php/tag/vba/)
+
+
+## 蘭雅CorelVBA工具箱  0520完整版下载
+### https://262235.xyz/262235_GMS_0520.7z
+
+## 蘭雅CorelVBA工具箱工具栏UI功能导图 
+![](https://262235.xyz/usr/uploads/2022/05/756737974.jpg)
 
 --------------------------------------------
 

UI/CorelVBA.bas

@@ -46,7 +46,7 @@ End Sub
 
 Private Sub ToolBar_show_Click()
   Unload Me
-  Toolbar.show 0
+  Toolbar.Show 0
 End Sub
 
 Private Sub UserForm_Initialize()
@@ -179,7 +179,7 @@ End Sub
 
 Private Sub 批量替换()
   CorelVBA.Hide
-  Replace_UI.show 0
+  Replace_UI.Show 0
 End Sub
 
 Private Sub 拼版标记()
@@ -200,7 +200,7 @@ End Sub
 
 Private Sub CQL选择()
   CorelVBA.Hide
-  CQL_FIND_UI.show 0
+  CQL_FIND_UI.Show 0
 End Sub
 
 

UI/Toolbar.bas

@@ -6,15 +6,12 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Toolbar
    ClientTop       =   330
    ClientWidth     =   6750
    OleObjectBlob   =   "Toolbar.frx":0000
-   StartUpPosition =   1  '所有者中心
 End
 Attribute VB_Name = "Toolbar"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
-
-
 #If VBA7 Then
     Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
     Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
@@ -34,6 +31,8 @@ Private Const GWL_EXSTYLE = (-20)
 Private Const WS_CAPTION As Long = &HC00000
 Private Const WS_EX_DLGMODALFRAME = &H1&
 
+Public UIL_Key As Boolean
+Public pic1, pic2
 
 Private Sub CommandButton3_Click()
   Speak_Msg "修改UI图片更换界面  注册表关闭语音 详QQ群"
@@ -55,8 +54,8 @@ Private Sub UserForm_Initialize()
   
 With Me
   .StartUpPosition = 0
-  .Left = 400    ' 设置工具栏位置
-  .Top = 55
+  .Left = Val(GetSetting("262235.xyz", "Settings", "Left", "400"))  ' 设置工具栏位置
+  .Top = Val(GetSetting("262235.xyz", "Settings", "Top", "55"))
   .Height = 30
   .Width = 336
 End With
@@ -69,12 +68,30 @@ End With
   Line_len.text = API.GetSet("Line_len")
   Outline_Width.text = GetSetting("262235.xyz", "Settings", "Outline_Width", "0.2")
   
-  
   UIFile = Path & "GMS\262235.xyz\ToolBar.jpg"
   If API.ExistsFile_UseFso(UIFile) Then
     UI.Picture = LoadPicture(UIFile)   '换UI图
+    Set pic1 = LoadPicture(UIFile)
   End If
-  
+
+  UIL = Path & "GMS\262235.xyz\ToolBar1.jpg"
+  If API.ExistsFile_UseFso(UIL) Then
+    Set pic2 = LoadPicture(UIL)
+    UIL_Key = True
+  End If
+
+End Sub
+
+Private Sub UI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
+  UI.Visible = False
+  If Y > 1 And Y < 16 And UIL_Key Then
+    UI.Picture = pic2
+  ElseIf Y > 16 And UIL_Key Then
+    UI.Picture = pic1
+  End If
+    UI.Visible = True
+
+  ' Debug.Print X & " , " & Y
 End Sub
 
 Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
@@ -129,7 +146,7 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
   pos_y = Array(14)
   pos_x = Array(14, 41, 67, 94, 121, 148, 174, 201, 228, 254, 281, 308, 334, 361, 388, 415, 441, 468, 495)
 
-  '//扩展键按钮优先  ①右键收缩工具栏   ②右键居中页面    ③右键尺寸取整数    ④右键单色黑中线标记  ⑤右键单色黑中线标记
+  '// 鼠标右键 扩展键按钮优先  收缩工具栏  标记范围框  居中页面 尺寸取整数  单色黑中线标记 扩展工具栏  排列工具  扩展工具栏收缩
   If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
     Me.Width = 30
     UI.Visible = False
@@ -141,6 +158,10 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
     Tools.居中页面
     Exit Sub
 
+  ElseIf Abs(X - pos_x(2)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
+    Tools.Mark_Range_Box
+    Exit Sub
+
   ElseIf Abs(X - pos_x(3)) < 14 And Abs(Y - pos_y(0)) < 14 And Button = 2 Then
     Tools.尺寸取整
     Exit Sub
@@ -176,7 +197,7 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
 
   End If
   
-  '// 鼠标单击按钮  按工具栏上图标正常功能
+  '// 鼠标左键 单击按钮功能  按工具栏上图标正常功能
   If Abs(X - pos_x(0)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     裁切线.start
     
@@ -199,10 +220,10 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
     智能群组和查找.智能群组
     
   ElseIf Abs(X - pos_x(7)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-    CQL_FIND_UI.show 0
+    CQL_FIND_UI.Show 0
     
   ElseIf Abs(X - pos_x(8)) < 14 And Abs(Y - pos_y(0)) < 14 Then
-    Replace_UI.show 0
+    Replace_UI.Show 0
     
   ElseIf Abs(X - pos_x(9)) < 14 And Abs(Y - pos_y(0)) < 14 Then
     Tools.TextShape_ConvertToCurves
@@ -222,13 +243,16 @@ Private Sub UI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal
     LOGO.Visible = True
     X_EXIT.Visible = True
     
+    ' 保存工具条位置 Left 和 Top
+    SaveSetting "262235.xyz", "Settings", "Left", Me.Left
+    SaveSetting "262235.xyz", "Settings", "Top", Me.Top
+  
     Speak_Msg "左键缩小 右键收缩"
   End If
 
 
 End Sub
 
-
 Private Sub X_EXIT_Click()
   Unload Me    ' 关闭
 End Sub
@@ -284,7 +308,7 @@ End Sub
 
 Private Sub OPEN_UI_BIG_Click()
   Unload Me
-  CorelVBA.show 0
+  CorelVBA.Show 0
 End Sub
 
 Private Sub Settings_Click()
@@ -294,6 +318,10 @@ Private Sub Settings_Click()
    SaveSetting "262235.xyz", "Settings", "Outline_Width", Outline_Width.text
   End If
 
+  ' 保存工具条位置 Left 和 Top
+  SaveSetting "262235.xyz", "Settings", "Left", Me.Left
+  SaveSetting "262235.xyz", "Settings", "Top", Me.Top
+  
   Me.Height = 30
 End Sub
 
@@ -409,7 +437,7 @@ Private Sub UniteOne_BT_MouseDown(ByVal Button As Integer, ByVal Shift As Intege
   If Button = 2 Then
     ' 右键
   ElseIf Shift = fmCtrlMask Then
-    UniteOne.show 0
+    UniteOne.Show 0
     Speak_Msg "多页合并一页"
   Else
     ' Ctrl + 鼠标  空

module/CorelVBA窗口.bas

@@ -1,8 +1,8 @@
 Attribute VB_Name = "CorelVBA窗口"
 Public Sub start()
-  Toolbar.show 0
-  CorelVBA.show 0
-  MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA中秋节版" & vbNewLine & "coreldrawvba插件交流群  8531411"
-  Speak_Msg "感谢您使用 蘭雅VBA工具"
+  Toolbar.Show 0
+'  CorelVBA.show 0
+'  MsgBox "请给我支持!" & vbNewLine & "您的支持，我才能有动力添加更多功能." & vbNewLine & "蘭雅CorelVBA中秋节版" & vbNewLine & "coreldrawvba插件交流群  8531411"
+'  Speak_Msg "感谢您使用 蘭雅VBA工具"
 End Sub
 

module/Tools.bas

@@ -504,3 +504,15 @@ ErrorHandler:
 End Function
 
 
+Public Function Mark_Range_Box()
+  If 0 = ActiveSelectionRange.Count Then Exit Function
+  ActiveDocument.Unit = cdrMillimeter
+  Dim s1 As Shape, ssr As ShapeRange
+  
+  Set ssr = ActiveSelectionRange
+  Dim X As Double, Y As Double, w As Double, h As Double
+
+  ssr.GetBoundingBox X, Y, w, h
+  Set s1 = ActiveLayer.CreateRectangle2(X, Y, w, h)
+  s1.Outline.SetProperties Color:=CreateRGBColor(0, 255, 0) ' RGB 绿
+End Function