我自己把要用的素材都画好了，有没有什么办法一直放在cdr页面上，需要用了点一下就插入的办法呀？

Sub test() Dim x As Double, y As Double Dim s1 As Shape Dim shif As Long ActiveDocument.GetUserClick x, y, shif, 10, False, cdrCursorPick Set s1 = ActiveDocument.ActivePage.SelectShapesAtPoint(x, y, True) MsgBox s1.Type End Sub 运行此程序后，选择一个群组对象。Type类型为8（cdrSelectionShape）。怎么不是cdrGroupshape。如何转变为cdrSelectionShape类型。

Sub 形状对齐() 'ActiveSelectionRange 当前所选对象 ActiveSelectionRange.AlignAndDistribute 3, 0, 0, 0, False, 2 '水平居中 ActiveSelectionRange.AlignAndDistribute 3, 3, 0, 0, False, 2 '垂直居中 'ActiveSelectionRange.AlignAndDistribute 2, 0, 0, 0, False, 2 '左对齐 'ActiveSelectionRange.AlignAndDistribute 2, 1, 0, 0, False, 2 '上对齐 'ActiveSelectionRange.AlignAndDistribute 1, 1, 0, 0, False, 2 '右对齐 'ActiveSelectionRange.AlignAndDistribute 1, 2, 0, 0, False, 2 '下对齐 End Sub

先选取形状 Sub 形状中心点对齐() Dim sh As ShapeRange, x#, y# Set sh = ActiveSelectionRange x = sh(1).SnapPoints.BBox(9).PositionX - sh(2).SnapPoints.BBox(9).PositionX y = sh(1).SnapPoints.BBox(9).PositionY - sh(2).SnapPoints.BBox(9).PositionY sh(2).Move x, y End Sub

在 CorelDRAW 中，对象模型是按照一定的层次结构来组织的，如果你要使用 VBA 对CorelDRAW 二次开发，那么必须了解 CorelDRAW 中的对象模型。 本文全是手机打字（车站等车时），内容不多，还请耐心看完，相信你一定会有所收获。 首先必须明确，Application 这个对象是最顶层的对象，代表整个 CorelDRAW 应用程序（就是你当前使用的这个软件本身）。 其次，CorelDRAW 中最主要的一些对象为 Document（文档）、Page（页面）、Layer（图层）、Shape（形状）。 主要的模

先选择批注 Sub 批注_1缩放() Dim sh As ShapeRange, s1 As Shape, s2 As Shape Set sh = ActiveSelectionRange sh(1).Dimension.TextShape.Text.Story.Size = 20 '字体大小 sh(2).Dimension.Outline.Width = 0.5 '线条宽度 End Sub

Sub 批注_2节点数量坐标() Dim sh As ShapeRange, s1 As Shape, s2 As Shape Set sh = ActiveSelectionRange For i = 1 To 50 'Step 2 x1 = sh(1).SnapPoints.Edge(i, 0#).PositionX '节点x y1 = sh(1).SnapPoints.Edge(i, 0#).PositionY '节点y If x1 = 148.434 Then Exit For Debug.Print x1 & " , " & y1 Set s1 = ActiveLayer.CreateEllipse2(x1, y1, 4) '以节点为中心画圆 Set s2 = ActiveLayer.CreateArtisticText(x1, y1 - 3, i) '在小圆中间添加序号 If i > 9 Then s2.SetSize 5, 6 '调整序号宽高 sw = s2.SizeWidth '获取序号宽度 s2.LeftX

Sub Excel数组() '引用 Excel 数据创建数组 Dim Exl As Object, x1 As Object, arr, i&, j& Set Exl = CreateObject("Excel.Application") '创建Excel应用程序对象 Set xl = Exl.Workbooks.Open("F:\导向\课件1.2.3\CD数组测试.xlsx") '打开Excel工作簿 arr = xl.Sheets(1).Range("A1").CurrentRegion '单元格连续区域 xl.Close False '关闭工作簿。 Rem 测试输出数组内容 ' For i = 2 To UBound(arr, 1) ' For j = 2 To UBound(arr, 2) ' Debug.Print arr(i, j) ' Next ' Next End Sub

'======================================================================== '过程名称：打印全部菜单ID（用于自动化调用） '======================================================================== Public Sub listMenuItemIDs() On Error Resume Next Dim cmdbar, ctl For Each cmdbar In FrameWork.CommandBars Debug.Print cmdbar & "工具栏下面的菜单项：" For Each ctl In cmdbar.Controls Debug.Print vbTab & ctl.ID & " -> " & ctl.Caption Next Next End Sub 拿到ID后，就可以通过自动化框架提供的方法来调用指定的菜单，

在 CorelDRAW 中，可以通过 Page 对象的 SelectShapesFromRectangle 方法选中某个矩形范围内的所有其他形状，选中后得到选中的形状，再执行群组，就实现了矩形内组。 参考代码如下： Sub testInnerGroup() Dim sh As Shape, s As Shape Set s = ActiveShape ' 这是当前选中的矩形（请先在页面中选中） Set sh = ActivePage.SelectShapesFromRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY, False) ' 将选中的全部形状进行群组 sh.Shapes.All.Group MsgBox "矩形内组完成！" End Sub

vba 如何获取指定坐标的颜色值，类似像滴管工具获取指定点的颜色，VBA如何实现？

经核实吧主Zebe1989 未通过普通吧主考核。违反《百度贴吧吧主制度》第八章规定http://tieba.baidu.com/tb/system.html#cnt08 ，无法在建设 coreldrawvba吧 内容上、言论导向上发挥应有的模范带头作用。故撤销其吧主管理权限。百度贴吧管理组

https://tieba.baidu.com/p/9041272831?share=9105&fr=sharewise&share_from=post&sfc=copy&client_type=2&client_version=12.62.1.1&st=1717563083&is_video=false&unique=31BB6F38703E4F126B9A6CF0C520D5A8

在CDR中如何用CDRVBA代码吸管工具吸取导入CDR的JPG图片内指定座标的图片上的颜色VBA代码?

CorelDRAW中求对选定的多个对象进行连续编号 该怎么写

Sub Test() Dim s As Shape Dim x As Double, y As Double x = ActivePage.SizeWidth / 2 y = ActivePage.SizeHeight / 2 Set s = ActiveLayer.CreateArtisticText(x, y, "Some Text String" & vbCr & "With Two Lines") s.Text.AlignProperties.Alignment = cdrCenterAlignment With s.Text.FontProperties .Name = "Arial" .Size = 18 End With End Sub 从With开始程序中没反应，用的是coreldraw2017版本，请问是什么原因。

文本属性的段落中有一个语言间距的选项 在shape对象、TextRange对象里，本地窗口翻了一遍也没找到 有没有大佬指点一下

求助，菜鸟一个，刚会点VBA宏，用qrmaker.ocx生成二维码需要再粘贴到文档，CellPitch调也没用，生成的间隔太粗，效率也麻烦，想用createoleobject QRmakerCtrl.1，生成后发现没有Input输入口，不能更改，求大神们好心教教

CORELVBA对coreldraw的工作无疑带来很大的帮助，但是，微软提供了更好的工具vsta(visual studio tools for Applications),支持vb.net c#.net编程，如果只是无聊玩一下，请移步vba就好。如果看长远，还是vsta好，下面贴一个我的vsta做的插件截图。

火山CPG框架（作者：LYL、安若清风）—— 首发于CDR插件技术网。 它是一个基于火山中文开发平台封装的一个CDR开发库，能让新手、小白快速开发出一个属于自己的CPG插件，其优点是无需懂英文，全中文操作，编译后的CPG插件很难被反向解析出来，比传统的GMS插件具有更高的安全性，因为其本质上就是中文的C++。 现在，如果你想开发一个自己的CPG插件，可以试试该框架。可以不用学习C++、Delphi这些语言，特别是C++，对于新手入门门槛比较高。如果你有

Private Function xDrawLine(xStart As Double, yStart As Double, angle As Double, length As Double) As Shape '函数参数：xStart起点X坐标，yStart起点Y坐标，angle角度，length长度 Dim xEnd As Double Dim yEnd As Double xEnd = xStart + length * Cos(DegToRad(angle)) yEnd = yStart + length * Sin(DegToRad(angle)) ' 绘制线 Dim doc As CorelDRAW.Document Set doc = CorelDRAW.ActiveDocument Dim lineShape As CorelDRAW.Shape Set lineShape = doc.ActiveLayer.CreateLineSegment(xStart, yStart, xEnd, yEnd) ' 返回线段对象 Set xDrawLine = lineShape End Function Private Function

Private Sub UserForm_Activate() '窗体活动时取数据 Dim s As Shape Set s = ActiveShape CharSpacingVal.text = s.text.Story.CharSpacing LineSpacingVal.text = s.text.Story.LineSpacing End Sub

拿到 CorelDRAW 软件 Programs 目录所在的路径，例如：C:\Program Files\CorelDRAW_X4_SP2\Programs。 Public Function getCoreldrawProgramPath() As String Dim path As String path = Replace(Application.path, "\Draw", "\Programs") getCoreldrawProgramPath = path End Function

Sub WaveLineDot() ' 定义一个名为WaveLineDot的子程序，用于生成正负Sin波浪点加连线 ' 声明变量 Dim i As Integer ' 循环计数器 Dim jG As Double ' 用于设置点的间隔 Dim inX As Double ' 点的X坐标 Dim inY As Double ' 点的Y坐标 Dim inR As Double ' 圆的半径 Dim inSin As Double ' 当前点的Y坐标值，基于Sin函数 Dim infSin As Double ' 用于生成下一个点的Y坐标值，基于负Sin函数 Dim s1 As Shape ' 第一个创建的圆形对象 Dim s2 As Shape ' 第二个创建的圆形对象 Dim s1sR As N

Sub CreatesTriangleY() '小圆点阵组成三角形 CorelDRAW.ActiveDocument.Unit = cdrMillimeter '设置毫米单位 Dim s1 As Shape ' 声明一个Shape类型的变量s1，用于存储创建的小圆。 Dim s1R As New ShapeRange ' 声明一个ShapeRange类型的变量s1R，用于存储创建的一系列小圆。 Dim startX As Double ' 声明一个Double类型的变量startX，用于存储小圆的起始X坐标。 Dim startY As Double ' 声明一个Double类型的变量startY，用于存储小圆的起始Y坐标。 Dim CenS As Byte ' 声明一个Byte类型的变量C

Sub Test() '在选择图形内生成n=500个随机圆 CorelDRAW.ActiveDocument.Unit = cdrMillimeter If CorelDRAW.ActiveShape Is Nothing Then MsgBox "没有选择形状" Exit Sub End If Dim s1 As Shape Set s1 = CorelDRAW.ActiveShape Dim s2 As Shape Dim inX As Double Dim inY As Double Dim inRadius As Double Dim sR As New ShapeRange Dim i As Integer Dim n As Integer Dim count As Integer ' 用于计数循环的变量 count = 0 ' 初始化计数器为0 n = 500 While count < n ' 设置循环条件，直到生成100个圆 inX = Rnd * s1.SizeWidth + s1.LeftX inY = Rnd * s1

主要是用来获取一个页面边框范围内的所有图形，在页面边框外的则排除。 参数 p：指的是某个页面。 返回类型为形状集合（Shapes）。 Public Function getShapesInPageInside(p As Page) As Shapes Set getShapesInPageInside = Nothing If Not p Is Nothing Then Dim sh As Shape Set sh = p.SelectShapesFromRectangle(p.LeftX, p.TopY, p.RightX, p.BottomY, False) Set getShapesInPageInside = sh.Shapes End If End Function

Private Sub cb_AddCharSpacing_Click() '字间距、行间距各加100 Dim s As Shape Set s = ActiveShape s.text.Story.CharSpacing = s.text.Story.CharSpacing + 100 s.text.Story.LineSpacing = s.text.Story.LineSpacing + 100 set s = Nothing End Sub

唐小跃渐变样式CDR插件，可以实现快捷的渐变样式填充、简单3D特效字，一键设置渐变样式，非常实用的插件。 免费使用下载地址：https://cdrvba.com/plugin-evunmbj27ybu

Dim a, b, c, d As Double Dim P0x, P0y, P1x, P1y, P2x, P2y, P3x, P3y As DoublePrivate Sub cmd_3_Click() ActiveDocument.Unit = cdrMillimeter '设定文件单位为毫米 a = txt_a.Value b = txt_b.Value If a < b Then b = txt_a.Value a = txt_b.Value End If ' 取值（a>b） c = txt_c.Value ' Set s0 = ActiveLayer.CreateEllipse2(0, 0, a, b) '画个圆 Set s1 = ActiveLayer.CreateEllipse2(0, 0, a, b, 180#, 270#) '画个半圆 Set s2 = ActiveLayer.CreateLineSegment(0, 0, -b, b) ActiveDocument.AddToSelection s1, s2 Set ss1 = ActiveSelectionRange Set ss1 = ss1.ConvertOutlineToO

谈一谈我对VBA学习的认识和理解，以及提高VBA编程能力的方法。 欢迎大家一起来探讨，共同分享学习心得。

我发照片的这个效果能实现吗？就是把左边四边形的四个点对位到右边的四边形的四个点的位置上 我是想弄个程序 就跟智能替换似的一步完成 cdr自带的封套太慢了 一个图得两三分钟 要是客户频繁改图能累死 从程序角度能实现吗 左边的一般是一个群组 因为包含框和文字。右边就是一个变形过的四边形 然后用程序一步对位 cdr2020 有个克隆功能 可以克隆一个变形成右边的 然后左边修改右边同步变化。但是不支持添加新元素和移动字的位置间距什么的

Sub Test() Dim s As Shape Dim s1 As Shape Dim s2 As Shape Dim d As Document Dim t As Text Dim strText As String strText = "This is a test. This text must be long enough to span across multiple columns In this frame. By adding this sentence, this text is now long enough." strText = strText & " This is the next sentence. " & strText Set d = CreateDocument Set s = d.ActiveLayer.CreateParagraphText(2, 2, 5, 5, strText) Set s1 = d.ActiveLayer.CreateParagraphText(5, 5, 8, 8) Set s2 = d.ActiveLayer.CreateParagraphText(8, 8, 10, 10) Set t = s.Text ' 将框架链接到

请问批量证卡怎么写？有参考码或者教程吗？

无聊时写个随机画线用做底纹，免得上网抄。

本文将介绍用VBA在CoreDraw添加页面及插入页面，并介绍纸张的设置方式，同时简单介绍了在新建的页面上添加相关对象的方法。 效果如图 代码： Sub AddPage() '将文档单位设置成毫米 ActiveDocument.Unit = cdrMillimeter '添加一个默认页面 ActiveDocument.AddPages (1) '添加五个默认页面 ActiveDocument.AddPages (5) Dim P As Page '添加一个默认页面，并将页面名称设为A，纸张设为A3，A3尺寸为420*297毫米，其他尺寸请自行百度 Set P = ActiveDocument.AddPages(1) P.SetSize 420,297 P.Name =

Sub removeBlankPage() ' 声明页面变量 Dim p As Page ' 遍历当前文档的所有页面（请打开文档，否则 ActiveDocument 为空会报错） For Each p In ActiveDocument.Pages ' 如果当前页面的形状数量为0，则删除当前页面 If p.Shapes.All.Count = 0 Then p.Delete Next p End Sub

Dim s As Shape Set s = ActiveShape If s.Type <> cdrCurveShape Then MsgBox "你选择的不是曲线对象": Exit Sub Dim n1 As Node, n2 As Node Set n1 = s.Curve.Nodes(1) Set n2 = s.Curve.Nodes(2) Dim distance As Double distance = n1.GetDistanceFrom(n2)

CorelDraw 文档中VBA代码如下： Private Sub Document_Open() UserForm1.Show End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ThisDocument.Activate ThisDocument.Close End Sub 打开文档会加载UserForm1， 但是执行关闭UserForm，执行到ThisDocument.Close时会报错，提示80004005，无法从文档事件图柄关闭文档； 如果先打开文档，再加载VBA，运行此命令则不会出现错误 想问下打开文档加载UserForm1，关闭UserForm1则关闭文档的方法

CDR9.0 CorelDRAW.Application 下没有 VBE ，如何操作。 还有一个 activedocument.Close 无法关闭

牛为设计大师已在CDR插件技术网首发，牛为设计大师是一款专注平面设计的CDR插件，为广大设计师和相关工作提供日常高频操作的插件功能，利用自动化技术，提高工作效率。当前首发版本的功能主要包含：文件操作、内容操作、导入模板、导出PDF、尺寸标注、高级阵列、节点操作等，后续将发布更多实用的功能，敬请期待！ 如果插件使用过程中有任何问题和建议，欢迎在此贴讨论。

创建段落文本，然后将最后一个字符填充为RGB红色。 Sub Test() Dim t As Text Dim s As Shape Dim d As Document Set d = CreateDocument Set s = d.ActiveLayer.CreateParagraphText(2, 2, 8, 8, "CDR插件技术网") Set t = s.Text t.Story.Characters.Last.Fill.UniformColor.RGBAssign 155, 0, 0 End Sub

Dim path As String path = "D:\新建文件夹" CorelScriptTools.MkFolder (path)