CorelVBA_Base_1129.bas 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859
  1. Sub mm()
  2. Application.FrameWork.Automation.Invoke "8e843a39-b9a2-a7b3-4714-21523261745f"
  3. End Sub
  4. Sub make_PageMark()
  5. ActiveDocument.Unit = cdrMillimeter
  6. '// 获得页面中心点 x,y ; 页面大小
  7. px = ActivePage.CenterX
  8. py = ActivePage.CenterY
  9. Pw = ActivePage.SizeWidth
  10. Ph = ActivePage.SizeHeight
  11. '// 开始画圆
  12. Dim s As Shape
  13. Set s = ActiveLayer.CreateEllipse2(px, py, Pw / 2, Ph / 2) '// 页面尺寸的圆
  14. r = 6# / 2 '// 圆直径6mm
  15. Set s1 = ActiveLayer.CreateEllipse2(8, 8, r, r)
  16. Set s2 = ActiveLayer.CreateEllipse2(Pw - 8, 8, r, r)
  17. Set s3 = ActiveLayer.CreateEllipse2(8, Ph - 8, r, r)
  18. Set s4 = ActiveLayer.CreateEllipse2(Pw - 8, Ph - 8, r, r)
  19. Set s3fz = ActiveLayer.CreateRectangle2(8 + r, Ph - 8 - 1 + r, 2, 1)
  20. '// 使用 ShapeRange 批量物件修改颜色和群组
  21. Dim sr As New ShapeRange
  22. sr.Add s1: sr.Add s2: sr.Add s3: sr.Add s4: sr.Add s3fz
  23. sr.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
  24. For Each sh In sr
  25. sh.Outline.SetNoOutline
  26. Next sh
  27. '// 组合,建立名字
  28. Set s = sr.Combine
  29. s.Name = "RoundMark"
  30. s.AddToSelection
  31. End Sub
  32. Public Sub page_add_Rect()
  33. Dim sr As New ShapeRange
  34. W = 5: H = 5: x = 5
  35. x2 = ActivePage.SizeWidth - 10
  36. y = ActivePage.SizeHeight - 50
  37. For I = 1 To (ActivePage.SizeHeight + 140) / 160
  38. Set s1 = ActiveLayer.CreateRectangle2(x, y, W, H)
  39. Set s2 = ActiveLayer.CreateRectangle2(x2, y, W, H)
  40. y = y - 160
  41. sr.Add s1: sr.Add s2 '// 添加到sr 用以群组修改
  42. Next I
  43. '// 改颜色,群组选择
  44. sr.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
  45. sr.Group: sr.CreateSelection
  46. End Sub