1
1

UniteOne.frm 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UniteOne
  3. Caption = "Merge Multiple Pages Into One"
  4. ClientHeight = 4005
  5. ClientLeft = 45
  6. ClientTop = 330
  7. ClientWidth = 5220
  8. OleObjectBlob = "UniteOne.frx":0000
  9. StartUpPosition = 1 'CenterOwner
  10. End
  11. Attribute VB_Name = "UniteOne"
  12. Attribute VB_GlobalNameSpace = False
  13. Attribute VB_Creatable = False
  14. Attribute VB_PredeclaredId = True
  15. Attribute VB_Exposed = False
  16. #If VBA7 Then
  17. Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  18. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  19. #Else
  20. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  21. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  22. #End If
  23. Dim iHang, iLie, iPages As Integer '// 定义行数(Y) 列数(X)
  24. Dim iYouyi, iXiayi As Single '// 右移(R) 下移(B)
  25. '// txtHang, txtLie, txtYouyi, txtXiayi ,txtInfo
  26. Dim LogoFile As String '// Logo
  27. Dim s(1 To 255) As Shape '// 定义对象用于存放每页的群组
  28. Dim P As Page '// 定义多页
  29. '// *********** 初始化程序 ***************
  30. Private Sub UserForm_Initialize()
  31. Dim s As Shape
  32. ActiveDocument.Unit = cdrMillimeter '// 本文档单位为mm
  33. For Each P In ActiveDocument.Pages
  34. iPages = P.index
  35. If iPages = 1 Then
  36. P.Activate
  37. P.Shapes.all.CreateSelection
  38. Set s = ActiveDocument.Selection
  39. If s.Shapes.Count = 0 Then
  40. MsgBox i18n("The current document's first page is blank and has no objects.", LNG_CODE)
  41. Exit Sub
  42. End If
  43. End If
  44. Next P
  45. txtLie.text = 5
  46. txtHang.text = Int(iPages / CInt(txtLie.text) + 0.9)
  47. txtLie.text = Int(iPages / CInt(txtHang.text) + 0.9)
  48. iHang = CInt(txtHang.text)
  49. iLie = CInt(txtLie.text)
  50. iYouyi = Int(s.SizeWidth + 0.6)
  51. iXiayi = Int(s.SizeHeight + 0.6)
  52. txtYouyi.text = iYouyi
  53. txtXiayi.text = iXiayi
  54. LogoFile = path & "GMS\LYVBA\LOGO.jpg"
  55. If API.ExistsFile_UseFso(LogoFile) Then
  56. LogoPic.Picture = LoadPicture(LogoFile) '// 换LOGO图
  57. End If
  58. LNG_CODE = API.GetLngCode
  59. Init_Translations Me, LNG_CODE
  60. Me.Caption = i18n("Merge Multiple Pages Into One", LNG_CODE)
  61. Me.Matrix.Caption = i18n("Matrix", LNG_CODE)
  62. Me.OffsetSelection.Caption = i18n("Offset Selection", LNG_CODE)
  63. txtInfo.text = i18n("Total Pages:", LNG_CODE) & iPages & " " & i18n("Home Page Shape Size(mm):", LNG_CODE) & s.SizeWidth & "x" & s.SizeHeight
  64. End Sub
  65. '**** 主程序 执行
  66. Private Sub cmdRun_Click()
  67. API.BeginOpt
  68. Dim x_M, y_M
  69. ActiveDocument.EditAcrossLayers = False '// 跨图层编辑禁止
  70. For Each P In ActiveDocument.Pages
  71. P.Activate '// 激活每页
  72. P.Shapes.all.CreateSelection '// 每页全选
  73. Set s(P.index) = ActiveSelection.Group '// 存放每页的群组
  74. Next P
  75. ActiveDocument.EditAcrossLayers = True '// 跨图层编辑开启
  76. x_M = y_M = 0
  77. For Each P In ActiveDocument.Pages
  78. P.Activate
  79. s(P.index).MoveToLayer ActivePage.DesktopLayer '// 每页对象移动到桌面层
  80. s(P.index).Move (iYouyi * x_M), -(300 + iXiayi * y_M) '// 排列对象 右偏移,下偏移
  81. y_M = y_M + 1
  82. If y_M = iLie Then
  83. x_M = x_M + 1
  84. y_M = 0
  85. End If
  86. Next P
  87. Unload Me
  88. API.EndOpt
  89. End Sub
  90. '**** 主程序 副本 横排序
  91. Private Sub cmdRunX_Click()
  92. API.BeginOpt
  93. Dim x_M, y_M
  94. ActiveDocument.Unit = cdrMillimeter
  95. ActiveDocument.EditAcrossLayers = False
  96. For Each P In ActiveDocument.Pages
  97. P.Activate
  98. P.Shapes.all.CreateSelection
  99. Set s(P.index) = ActiveSelection.Group
  100. Next P
  101. ActiveDocument.EditAcrossLayers = True
  102. x_M = y_M = 0
  103. For Each P In ActiveDocument.Pages
  104. P.Activate
  105. s(P.index).MoveToLayer ActivePage.DesktopLayer
  106. s(P.index).Move (iYouyi * y_M), -(600 + iXiayi * x_M)
  107. y_M = y_M + 1
  108. If y_M = iHang Then
  109. x_M = x_M + 1
  110. y_M = 0
  111. End If
  112. Next P
  113. Unload Me
  114. API.EndOpt
  115. End Sub
  116. '// 关闭
  117. Private Sub cmdClose_Click()
  118. Unload Me
  119. End Sub
  120. '// VB限制文本框只能输入数字和小数点
  121. Private Sub txtHang_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  122. Dim Numbers As String
  123. Numbers = "1234567890"
  124. If InStr(Numbers, Chr(KeyAscii)) = 0 Then
  125. KeyAscii = 0
  126. End If
  127. End Sub
  128. Private Sub txtLie_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  129. Dim Numbers As String
  130. Numbers = "1234567890"
  131. If InStr(Numbers, Chr(KeyAscii)) = 0 Then
  132. KeyAscii = 0
  133. End If
  134. End Sub
  135. Private Sub txtXiayi_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  136. Dim Numbers As String
  137. Numbers = "1234567890" + Chr(8) + Chr(46)
  138. If InStr(Numbers, Chr(KeyAscii)) = 0 Then
  139. KeyAscii = 0
  140. End If
  141. End Sub
  142. Private Sub txtYouyi_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  143. Dim Numbers As String
  144. Numbers = "1234567890" + Chr(8) + Chr(46)
  145. If InStr(Numbers, Chr(KeyAscii)) = 0 Then
  146. KeyAscii = 0
  147. End If
  148. End Sub
  149. Private Sub txtHang_Change()
  150. Dim n As Single
  151. n = Val(txtHang.text)
  152. If n > 0 And n < 1001 Then
  153. HangSpin.value = n
  154. iHang = n
  155. End If
  156. txtHang.text = iHang
  157. txtLie.text = Int(iPages / iHang + 0.9)
  158. iLie = CInt(txtLie.text)
  159. End Sub
  160. Private Sub HangSpin_Change()
  161. txtHang.text = CStr(HangSpin.value)
  162. End Sub
  163. Private Sub txtLie_Change()
  164. Dim n As Single
  165. n = Val(txtLie.text)
  166. If n > 0 And n < 1001 Then
  167. LieSpin.value = n
  168. iLie = n
  169. End If
  170. txtLie.text = iLie
  171. txtHang.text = Int(iPages / iLie + 0.9)
  172. iHang = CInt(txtHang.text)
  173. End Sub
  174. Private Sub LieSpin_Change()
  175. txtLie.text = CStr(LieSpin.value)
  176. End Sub
  177. Private Sub txtXiayi_Change()
  178. Dim n As Single
  179. n = Val(txtXiayi.text)
  180. If n > 0 And n < 1001 Then
  181. iXiayi = n
  182. End If
  183. End Sub
  184. Private Sub txtYouyi_Change()
  185. Dim n As Single
  186. n = Val(txtYouyi.text)
  187. If n > 0 And n < 1001 Then
  188. iYouyi = n
  189. End If
  190. End Sub