'======================================================================== '过程名称：打印全部菜单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后，就可以通过自动化框架提供的方法来调用指定的菜单，

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 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对象里，本地窗口翻了一遍也没找到 有没有大佬指点一下

我自己弄了个插件 不想让别人直接使用 怎么可以让插件有一个使用周期 到了设定的周期后让其无法使用

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

有添加马克点的插件？

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

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

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

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

火山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)

如题，有什么问题可以在这个吧提问，我会抽空解答！

'=============================================================== ' 方法：创建两个图形之间的调和效果 '=============================================================== Sub createBlendEffect() ' 判断是否选择了至少2个形状 If ActiveSelection.Shapes.count <> 2 Then MsgBox "请选择2个要调和的图形" Exit Sub End If ' 定义混合效果 Dim eff1 As Effect ' 取得要混合的两个图形 Dim s1 As Shape, s2 As Shape Set s1 = ActiveSelection.Shapes(1) Set s2 = ActiveSelection.Shapes(2) ' 创建混合效果 Set eff1 = s1.Crea

如题，内容放下面

corledraw导入图片到指定方框位置，并进行重放样贴图用那几个函数？求回复

有没有人会写智能群组或结合功能啊？自动判断中文英文，自动将每一个字的笔画组合到一起，准确率要求百分之九十九以上的方法？求大神指点

计算矩形的周长和面积。 '================================================== ' 方法：计算矩形的周长和面积 '================================================== Sub calculateRectangle() ' 判断当前是否选择了形状 Dim sh As Shape Set sh = ActiveShape If sh Is Nothing Then MsgBox "请先选中一个形状" Exit Sub End If ' 判断选择的形状是不是矩形 If sh.Type <> cdrRectangleShape Then MsgBox "你选中的不是矩形，请选中矩形" Exit Sub End If ' 改变文档单位 ActiveDocument.Unit = cdrMillimeter

下载文件到本地指定目录，使用的是 URLDownloadToFile 这个系统函数。 Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long '=============================================================================== ' 函数：下载文件到指定目录 ' 作用：下载文件到指定目录，下载成功时返回True，否则返回False ' 参数：fileUrl -> 要下载的文件完整路

通过CorelDRAW提供的框架自动化调用能力（FrameWork.Automation），我们可以实现在代码中，一行代码调用指定的功能，这段代码用来列出菜单的唯一ID和标题。调用方式：Application.FrameWork.Automation.InvokeItem "菜单ID"。 '================================================= ' 方法：打印CommandBar信息 ' 作用：将所有CommandBar信息全部打印出来，用于自动化调用 '================================================= Public Sub printCommandBarItemInfo() On Error Resume Next Dim cmdbar, ctl For Each c

利用URL属性给对象打标签，用来实现模板化操作。既可以通过代码来标记对象，也可以手动动过对象属性面板来设置URL的地址属性。 '======================================= ' 方法：利用URL属性给对象打标签 '======================================= Sub markShapeWithUrl() ' 判断当前是否选择了形状 Dim sh As Shape Set sh = ActiveShape If sh Is Nothing Then MsgBox "请先选中一个形状" Exit Sub End If ' 给对象打URL属性标记 sh.url.Address = "自定义标记内容" MsgBox "标记

在 ActiveLayer 对象中，可以通过 CreateEllipse 这个方法，使用 4 个参数来创建椭圆或者圆形。椭圆和圆形的区别在于半径的不同。 Public Sub test() ' 定义一个形状对象 Dim s As Shape ' 设置当前活动文档的单位为毫米 ActiveDocument.Unit = cdrMillimeter ' 在当前活动图层创建一个椭圆（默认坐标参考点是左下角，请改变 ActiveDocument.ReferencePoint 的值来尝试不同效果） Dim left, top, right, bottom left = 10 ' 从文档左边距离1厘米处开始绘制 top = 10 ' 从距离底部距离1厘