VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} VBA_FORM Caption = "Hello_VBA" ClientHeight = 10080 ClientLeft = 45 ClientTop = 390 ClientWidth = 6180 OleObjectBlob = "VBA_FORM.frx":0000 StartUpPosition = 1 'CenterOwner End Attribute VB_Name = "VBA_FORM" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub AutoRotate_Click() Tools.自动旋转角度 End Sub Private Sub btn_autoalign_bycolumn_Click() autogroup("group", 1).CreateSelection End Sub Private Sub btn_corners_off_Click() Tools.corner_off End Sub Private Sub btn_ExpandForm_Click() With Me If .Width = 200 Then .Width = 260: .Height = 132 ElseIf .Height = 132 Then .Height = 206 Else .Width = 200: .Height = 105 End If End With End Sub Private Sub cmd_Batch_Center_Click() Container.Batch_Center End Sub Private Sub CommandButton1_Click() autogroup("group", 2).CreateSelection End Sub Private Sub CB_AQX_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) If Button = 2 Then Tools.guideangle ActiveSelectionRange, 0# ' 右键 0距离贴紧 ElseIf Shift = fmCtrlMask Then Tools.guideangle ActiveSelectionRange, 4 ' 左键安全范围 4mm Else Tools.guideangle ActiveSelectionRange, -10 ' Ctrl + 鼠标左键 End If End Sub Private Sub CB_BZCC_Click() Tools.尺寸标注 End Sub Private Sub CB_ECWZ_Click() Tools.填入居中文字 GetClipBoardString End Sub Private Sub CB_JDZP_Click() Tools.角度转平 End Sub Private Sub CB_JHDX_Click() Tools.交换对象 End Sub Private Sub CB_make_sizes_Click() Tools.Make_Sizes End Sub Private Sub CB_PLBZ_Click() Tools.批量标注 End Sub Private Sub CB_PLDYJZ_Click() Tools.批量多页居中 End Sub Private Sub CB_PLWZ_Click() Tools.批量居中文字 "CorelVBA批量文字" End Sub Private Sub CB_QZJZ_Click() Tools.群组居中页面 End Sub Private Sub CB_SIZESORT_Click() splash.Show 1 End Sub Private Sub CB_VBA_Click() MsgBox "你好 CorelVBA!" End Sub Private Sub CB_VBA_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) CB_VBA.BackColor = RGB(255, 0, 0) End Sub Private Sub CB_ZDJD_Click() Tools.自动旋转角度 End Sub Private Sub CB_mirror_by_line_Click() Tools.参考线镜像 End Sub Private Sub CommandButton2_Click() Tools.服务器T End Sub Private Sub CommandButton3_Click() Dim sr As ShapeRange Dim shr As ShapeRange Set sr = ActiveSelectionRange Set shr = ActivePage.Shapes.All If sr.Shapes.Count = 0 Then shr.CreateSelection '所有对象 Else shr.RemoveRange sr shr.CreateSelection '不在原选择范围内的对象 End If End Sub Private Sub ExportNodePot_Click() Tools.ExportNodePositions End Sub Private Sub Image7_Click() arrow.Show 0 Unload Me End Sub Private Sub Image8_Click() frmSelectSame.Show 0 Unload Me End Sub Private Sub OneKeyToPowerClip_Click() Container.OneKey_ToPowerClip End Sub Private Sub Photo_Form_Click() PhotoForm.Show 0 End Sub Private Sub BatchToPowerClip_Click() Container.Batch_ToPowerClip End Sub Private Sub Print_Page_Click() ActivePage.Shapes.All.Move ActivePage.CenterX - ActiveSelectionRange.CenterX, ActivePage.CenterY - ActiveSelectionRange.CenterY ' 等价下面几行代码 ' Dim sr As ShapeRange, shr As ShapeRange ' Set sr = ActiveSelectionRange ' Set shr = ActivePage.Shapes.All ' X = sr.CenterX ' Y = sr.CenterY ' px = ActivePage.CenterX ' py = ActivePage.CenterY ' shr.Move px - X, py - Y End Sub Private Sub RemoveShapes_OutsideBox_Click() Container.Remove_OutsideBox End Sub Private Sub SelectOnMargin_Click() Container.Select_OnMargin End Sub Private Sub SelectOutsideBox_Click() Container.Select_OutsideBox End Sub Private Sub Set_BoxName_Click() Container.SetBoxName End Sub Private Sub SetNames_Click() Tools.SetNames End Sub Private Sub SplitSegment_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) If Button = 2 Then MsgBox "左键拆分线段,Ctrl合并线段" ElseIf Shift = fmCtrlMask Then Tools.Split_Segment Else ActiveSelection.CustomCommand "ConvertTo", "JoinCurves" Application.Refresh End If End Sub Private Sub Image4_Click() cmd_line = "Notepad D:\备忘录.txt" Shell cmd_line, vbNormalNoFocus End Sub Private Sub Image5_Click() Shell "Calc" End Sub Private Sub LevelRuler_Click() Tools.角度转平 End Sub Private Sub MakeSizes_Click() ZCOPY.Show 0 End Sub Private Sub MirrorLine_Click() Tools.参考线镜像 End Sub Private Sub SortCount_Click() Tools.按面积排列 50 End Sub Private Sub SwapShape_Click() Tools.交换对象 End Sub Private Sub TESTPIC__MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) TESTPIC.SpecialEffect = fmSpecialEffectSunken End Sub Private Sub UserForm_Click() End Sub Private Sub ZNQZ_Click() Tools.智能群组 End Sub Private Sub 读取文本_Click() AutoCutLines.AutoCutLines End Sub Sub 读取每一行数据() Dim txt As Object, t As Object, path As String Set txt = CreateObject("Scripting.FileSystemObject") Dim a ' 指定路径 path = "R:\Temp.txt" ' “1”表示只读打开,“2”表示写入,True表示目标文件不存在时是创建 Set t = txt.OpenTextFile(path, 1, True) '-------------------------- ' 读取每一行并把内容显示出来 Do While Not t.AtEndOfStream ' a = t.ReadLine a = a & t.ReadLine & vbNewLine TextBox1.Value = a Loop '-------------------------- ' 打开文档,注意“notepad.exe ”最后有空格 Shell "notepad.exe " & path, vbNormalFocus ' 释放变量 Set t = Nothing Set txt = Nothing End Sub Private Sub 裁切线_Click() AutoCutLines.AutoCutLines End Sub Private Sub 手动拼版_Click() ArrangeForm.Show 0 End Sub Private Sub 算法计算_Click() ChatGPT.计算行列 End Sub Private Sub Z序排列_Click() ChatGPT.Z序排列 End Sub Private Sub U序排列_Click() ChatGPT.正式U序排列 End Sub