|
@@ -1,6 +1,6 @@
|
|
|
VERSION 5.00
|
|
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ArrangeForm
|
|
|
- Caption = "蘭雅sRGB 手动拼版 │ 嘉盟赞助"
|
|
|
+ Caption = "蘭雅sRGB 手动拼版"
|
|
|
ClientHeight = 2475
|
|
|
ClientLeft = 45
|
|
|
ClientTop = 330
|
|
@@ -16,15 +16,12 @@ Attribute VB_GlobalNameSpace = False
|
|
|
Attribute VB_Creatable = False
|
|
|
Attribute VB_PredeclaredId = True
|
|
|
Attribute VB_Exposed = False
|
|
|
-
|
|
|
-
|
|
|
Private Sub CommandButton1_Click()
|
|
|
On Error GoTo ErrorHandler
|
|
|
- ActiveDocument.Unit = cdrMillimeter
|
|
|
- Dim ls As Integer, hs As Integer
|
|
|
- Dim lj As Double, hj As Double
|
|
|
- Dim matrix As Variant
|
|
|
- Dim s As ShapeRange
|
|
|
+ API.BeginOpt
|
|
|
+
|
|
|
+ Dim ls, hs As Integer: Dim lj, hj As Double
|
|
|
+ Dim matrix As Variant: Dim sr As ShapeRange
|
|
|
|
|
|
ls = Val(TextBox1.text)
|
|
|
hs = Val(TextBox2.text)
|
|
@@ -32,52 +29,44 @@ Private Sub CommandButton1_Click()
|
|
|
hj = Val(TextBox4.text)
|
|
|
matrix = Array(ls, hs, lj, hj)
|
|
|
|
|
|
- Set s = ActiveSelectionRange
|
|
|
+ Set sr = ActiveSelectionRange
|
|
|
|
|
|
If ls * hs = 0 Then Exit Sub
|
|
|
If ls = 1 Or hs = 1 Then
|
|
|
- arrange_Clone_one matrix, s
|
|
|
- Exit Sub
|
|
|
+ arrange_Clone_one matrix, sr
|
|
|
+ GoTo ErrorHandler
|
|
|
End If
|
|
|
|
|
|
'// 代码运行时关闭窗口刷新
|
|
|
ActiveDocument.BeginCommandGroup: Application.Optimization = True
|
|
|
'// 拼版矩阵
|
|
|
- arrange_Clone matrix, s
|
|
|
-
|
|
|
- ActiveDocument.EndCommandGroup
|
|
|
+ arrange_Clone matrix, sr
|
|
|
Unload Me
|
|
|
|
|
|
- '// 代码操作结束恢复窗口刷新
|
|
|
- ActiveDocument.EndCommandGroup
|
|
|
- Application.Optimization = False
|
|
|
- ActiveWindow.Refresh: Application.Refresh
|
|
|
- Exit Sub
|
|
|
ErrorHandler:
|
|
|
- Application.Optimization = False
|
|
|
- On Error Resume Next
|
|
|
+ API.EndOpt
|
|
|
End Sub
|
|
|
|
|
|
-'// 拼版矩阵 matrix = Array(ls,hs,lj,hj)
|
|
|
-Private Function arrange_Clone(matrix As Variant, s As ShapeRange)
|
|
|
+'// 拼版矩阵 matrix = Array(ls, hs, lj, hj)
|
|
|
+Private Function arrange_Clone(matrix As Variant, sr As ShapeRange)
|
|
|
ls = matrix(0): hs = matrix(1)
|
|
|
lj = matrix(2): hj = matrix(3)
|
|
|
- X = s.SizeWidth: Y = s.SizeHeight
|
|
|
- Set s1 = s.Clone
|
|
|
+ x = sr.SizeWidth: Y = sr.SizeHeight
|
|
|
+ Set s1 = sr.Clone
|
|
|
'// StepAndRepeat 方法在范围内创建多个形状副本
|
|
|
- Set dup1 = s1.StepAndRepeat(ls - 1, X + lj, 0#)
|
|
|
+ Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
|
|
|
Set dup2 = ActiveDocument.CreateShapeRangeFromArray(dup1, s1).StepAndRepeat(hs - 1, 0#, -(Y + hj))
|
|
|
s1.Delete
|
|
|
End Function
|
|
|
|
|
|
-Private Function arrange_Clone_one(matrix As Variant, s As ShapeRange)
|
|
|
+Private Function arrange_Clone_one(matrix As Variant, sr As ShapeRange)
|
|
|
ls = matrix(0): hs = matrix(1)
|
|
|
lj = matrix(2): hj = matrix(3)
|
|
|
- X = s.SizeWidth: Y = s.SizeHeight
|
|
|
- Set s1 = s.Clone
|
|
|
+ x = sr.SizeWidth: Y = sr.SizeHeight
|
|
|
+ Set s1 = sr.Clone
|
|
|
'// StepAndRepeat 方法在范围内创建多个形状副本
|
|
|
If ls > 1 Then
|
|
|
- Set dup1 = s1.StepAndRepeat(ls - 1, X + lj, 0#)
|
|
|
+ Set dup1 = s1.StepAndRepeat(ls - 1, x + lj, 0#)
|
|
|
Else
|
|
|
Set dup1 = s1
|
|
|
End If
|