Dim s As Shape ActiveDocument.Unit = cdrPoint For Each s In ActiveSelectionRange If s.CanHaveOutline Then With s.Outline If Round(.Width, 2) < 1 Then .SetNoOutline Else .Width = .Width - 1 End If End With End If Next s End Sub

1、覆膜机的品牌 目前图文店使用的品牌有，好战友、爱普、荣大、道顿、古德、飞扬，本人使用过两三种品牌，大体来说感觉好战友的设备经不起折腾，用了一年坏了，辊子还错位，目前用的爱普的，经济实惠有3年多了还挺好用，荣大的机器使用钢棍，速度可调，进纸感应，带切刀，挺人性化，一分价钱一分货 2、覆膜机的使用 大部分的机器预热时间是5分钟左右，运行起来可调速的优势就很明显，100张覆膜不能调速其实也挺耗时间。机器在运行过

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

求助，有选择对象a,怎么通过代码实现对象b复制a的填充色。

第一种方法：选中子对象，剪切 -粘贴 第二种办法：相交-剪切 第三种办法：复制群组对象，选中原群组对象中的子对象删除，再把复制的群组对象解散群组，删除不要的子对象，留下需要分离的子对象

有不少朋友遇到这样的情况，买图需要花钱，这里提供了一个比较好的方法，ps修图+cdr描摹

下面一段代码是选定shaperange后执行 Sub tesetRange() Dim ShpRng As New ShapeRange Set ShpRng = ActiveSelectionRange Dim shp As Shape, temprng As New ShapeRange Debug.Print "总共个数：" & ShpRng.count For Each shp In ShpRng temprng.Add ShpRng.Shapes(ShpRng.count) ShpRng.RemoveRange temprng Debug.Print "还剩下个数：" & ShpRng.count Next shp End Sub 总共个数：5 还剩下个数：4 还剩下个数：3 还剩下个数：2 还剩下个数：1 还剩下个数：0 ---------------------------------------------------------- 再看看第二段代码

Sub Macro1() Dim s1 As Shape, OrigSelection As ShapeRange If ActiveSelectionRange.Count > 1 Then Set s1 = ActiveSelectionRange.Group Else: Set s1 = ActiveShape End If s1.AlignToPage cdrAlignHCenter + cdrAlignVCenter End Sub 该代码在X4版本工作正常，但是在2018工作不正常，不能运行 2018录制居中代码如图，函数发生了变化 如果自己编写代码需要考虑在不同的版本兼容： 于是换思路，直接对齐到某个点，cdr提供了这个函数： s1.AlignToPoint cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActiveDocument.ActivePage.C

Sub copytoallpages() Dim sr As ShapeRange, dup As ShapeRange Dim p As Page If ActiveSelectionRange.Count > 1 Then Exit Sub Set sr = ActiveSelectionRange For i = 1 To ActiveDocument.Pages.Count Set dup = sr.Duplicate() dup.MoveToLayer ActiveDocument.Pages(i).ActiveLayer Next i End Sub

修改了 很久的文件出现上图报错，看下是不是有个字体图层 字体丢失了 替换字体会出现上图报错，这时删除该字体图层再保存

将色彩模式改为8位的可以实现导入cdr保留图层

可以先安装微软常用运行库 然后在安装包中找到vba.msi 或者重新运行setup.exe来修改安装

每天正常使用电脑，突然一天出现这个情况 开网页就黑屏重启，有时候反复黑屏几下才重启 调到安全模式启动没有问题。 卸载显卡驱动后使用公版驱动没有问题。 重装系统后问题依然存在！！！ 经过专家指点，换了一根显示器数据线，搞定了，原来是数据线坏了。平时没注意，显示器数据线反复折弯顶到墙上，时间长了就坏了

如上箭头 可以通过画线，将线条端头改成圆角，最后轮廓转填充实现 也可以画长方形，然后对长方形圆角

Sub 移动选择到最后页() Dim sr As ShapeRange, x As Double, y As Double, w As Integer, p As Integer If ActiveDocument.Selection.Shapes.Count = 0 Then MsgBox "没有选择对象。": Exit Sub ActiveDocument.SaveSettings ActiveDocument.Unit = cdrTenthMicron ActiveDocument.ReferencePoint = cdrTopLeft ActiveDocument.DrawingOriginX = 0 ActiveDocument.DrawingOriginY = 0 ActiveDocument.ActivePage.GetSize x, y p = ActiveDocument.Pages.Count w = ActiveDocument.ActivePage.Index ActiveDocument.BeginCommandGroup "移动选择到最后页" Optimization = True EventsEnabled = False

'字号 SizeJ = ActiveShape.Text.Selection.Characters.All.Size sj = SizeJ * 0.03 '首行缩进 ActiveShape.Text.Selection.Characters.All.FirstLineIndent = sj

第一步处理好 所有的数据(数字前后加空格) 第二步 生成美术文本批量数据 第三步 用正则表达式 将所有数字改成红色 第4步 打散所有美术文本 第5步 选取相同填充色 红 最终步 批量旋转90度 搞定

很多时候需要平滑节点减少节点数量，但是这两个函数各司其职 s.Curve.Nodes.All.Smoothen 20 此函数只能执行一次，第二次执行将不会产生效果，修改参数也不会变化 s.Curve.Nodes.All.AutoReduce 0.05 需要多次减少节点可用AutoReduce Sub Macro1() ' Recorded 2018/11/21 Dim OrigSelection As ShapeRange Set OrigSelection = ActiveSelectionRange Dim s As Shape For Each s In OrigSelection.Shapes.FindShapes(Type:=cdrCurveShape).Shapes With s.Curve.Nodes.All .AutoReduce 1 '.Smoothen 20 End With Next s End Sub

不可能光栅问题，因为他的黑线没有错位，他是套色不准 一、打其他的图试一下 是否有重影 ，查看是不是文件的问题。 二、重装软件； 三、再检查机器 ， 如果是光纤的机，可以外置条光纤试试， 小车板一般都有2个通道，换一个通道看看会不会解决 如果有就是机器 或软件问题 没有问题则是文件的问题 文件问题 就看下是不是 深度是不是8位 然后 文件有没有路径 及通道 有多的是需要删除的 可以擦一下光栅 重装控制软件。 光栅 只会对会不准，

皮卡，微宏，金田 买红点激光，有6mm-15mm的，有光源耐用与不耐用的。 有的刻字机（比如皮卡）带有激光头插孔的，就很好改装。 买一个电池盒，为激光头供电。 如果直接连接机器上的220V电源，那就要买电压转换的 激光头定好后，就找出刻刀起点与红点的偏移位置，用十字线生成插件，生成十字定位点。以后每次刻的时候，打开激光，对准十字线，较准平行。就可以启动刻字了。 画一个外框，把激光红点对准外框的点，启动刻字，那刻出来的位置

旋转合并 第一步 直接按顺序骑马钉 第二步 奇数页 执行 顺时针90 偶数页 执行 逆时针90 第三步 胶装侧面

Sub 一键标注数字() Dim s As Shape Dim sr As New ShapeRange Dim txt As String Dim c As Color Dim i As Integer, k As Integer, js As Integer Set sr = ActiveSelectionRange.Shapes.FindShapes(, cdrTextShape, True) Set c = CreateCMYKColor(0, 100, 100, 0) For Each s In sr txt = s.Text.Story For i = 0 To 9 k = 1 js = InStr(k, txt, i) Do While js > 0 s.Text.Story.Characters(js, 1).Fill.UniformColor.CopyAssign c s.Text.Story.Characters(js, 1).Size = 10 k = js + 1 js = InStr(k, txt, i) Loop Next Next End Sub

跟cdr网状填充的区别： 1.颜色点可以自由拖，可以单独调节影响 2、点还可以画线

能不能让文字贴合到图片的边缘（而不是矩形边缘）如下图 方法：将叶子临摹后创建到容器中然后贴合吗，使段落文本绕图

边上修剪掉就对了

Sub Test() Dim d As Document Dim s As Shape Dim t As Text Set d = CreateDocument Set s = d.ActiveLayer.CreateParagraphText(3, 3, 5, 5, _ "This is an example. This is an example. This is an " & _ "example. This is an example. This is an example.") Set t = s.Text t.Story.LeftIndent = 0.5 End Sub

Sub aa() Dim sh As Shape Dim sr As New ShapeRange Dim jj As Double Set sr = ActiveSelectionRange jj = 20 ActiveDocument.Unit = cdrMillimeter For Each sh In sr.Shapes ActiveLayer.CreateRectangle sh.LeftX - jj, sh.TopY + jj, sh.RightX + jj, sh.BottomY - jj Next End Sub

Sub aa() Dim sh As Shape Dim sr As New ShapeRange Dim jj As Double Set sr = ActiveSelectionRange jj = 20 ActiveDocument.Unit = cdrMillimeter For Each sh In sr.Shapes ActiveLayer.CreateRectangle sh.LeftX - jj, sh.TopY + jj, sh.RightX + jj, sh.BottomY - jj Next End Sub

非打印字符

在PS中选中形状 然后CTRL+C 到AI CTRL+V

通过CDR的调和工具。适当修改节点位置可以改变形态 网状填充工具实现不同区域颜色填充

Sub aa() Dim i As Integer, j As Integer, sh As Shape, y As Double y = ActivePage.TopY For i = 1 To 3 For j = 1 To 31 Set sh = ActiveLayer.CreateArtisticText(ActivePage.LeftX, ActivePage.TopY, i & "排" & j & "号") sh.TopY = y y = sh.BottomY Next Next End Sub Excel公式也可以生成 =TEXT(INT(ROW()/31)+1,"0排")&TEXT(IF(MOD(ROW(),31)=0,31&"号",MOD(ROW(),31)),"0号")

1、在cdr工具栏双击矩形，建立页面等大矩形框 2、Ctrl+I选择导入文件 不要勾选导入备注并将其置于单独的图层 找到页面左上角 定位 原理就是PDF第一页就是带有一个A4尺寸的矩形 会自动建立新页面

1、彩色喷墨打印机的选择 绕不开Epson 、Canon两巨头，也许又要围绕热发泡和陶瓷压电来争论，本人体验过canonix4000 6580两个系列，一个直观的感觉，速度真快，色彩还过得去，但是不是特别理想，当然没有用过6色8色，感觉佳能的色彩引擎还是相对弱一些。EPSON一般用来打印照片，越高端的机型，颜色效果越好，更适合打印店用来打印照片，另外他的文本模式打印出来的文本也很黑白分明 2、机器的稳定性 canon、epson有很多经典机型，他们都有这些特点

目前有这样的机器： 不干胶划线机：只能用于不干胶划线，压米线，有人工进纸，自动进纸 压痕机：此机器可以划线、压米线、压痕，更换刀片即可，便宜实惠图文店应急可用，弥补印刷厂批量工单必须延长交货时间的缺陷 刻字模切机：用来切割异形贴纸，用它可以制作更多个性化的产品，比如logo贴，比如镂空名片，镂空画册封面， 刻玻璃贴字 这些产品可以极大的丰富图文快印店的产品结构，完善服务

施乐3360打印机能走300g白卡纸，但是300铜板纸会出现碳粉粘不住的现象，可能定影温度不够，有没有遇到此类问题的朋友，还是我哪里设置错了