希望老大们早点发布编程教程
如果能学到知识收点钱 也可以的。自己研究实在太慢,个人能力有限。有些又看不懂。
真心期待~~~
Sub xd33651817标注()
Dim s As Shape
ActiveDocument.Unit = cdrMillimeter
c = ActiveSelection.Shapes.Count
x1c = 0: x1m = 99: x1y = 0: x1k = 1
wb = InputBox("华友情提示!", "请输入标注内容", "如 你在就好了")
If ActiveDocument.Selection.Shapes.Count = 0 Then MsgBox ("请选择一个东西再上!"): Exit Sub
y = ActiveSelection.SizeHeight
x = ActiveSelection.SizeWidth
xx = ActiveSelection.PositionX
yy = ActiveSelection.PositionY
a1 = 50: a2 = 100: a3 = 150: a4 = 250: a5 = 100000
b4 = 80: b3 = 60: b2 = 40: b1 = 24
c4 = 20: c4 = 15: c3 = 10: c2 = 8: c1 = 5
If x < a5 Then zt = b4: jj = c4
If x < a4 Then zt = b3: jj = c3
If x < a3 Then zt = b2: jj = c2
If x < a2 Then zt = b1: jj = c1
Set s = ActiveDocument.ActivePage.ActiveLayer.CreateArtisticText(0, 0, wb, , , "arial", zt, False, False, , cdrLeftAlignment)
Set OrigSelection = ActiveSelectionRange
OrigSelection.ApplyUniformFill CreateCMYKColor(x1c, x1m, x1y, x1k)
ActiveSelection.Rotate 0
ActiveSelection.PositionX = xx + (x - ActiveSelection.SizeWidth) / 2
ActiveSelection.PositionY = yy + ActiveSelection.SizeHeight + jj
End Sub
这个标出来的字体会不一样
能不能加个方正大黑体 1688 发表于 2016-7-9 22:53
Sub xd33651817标注()
Dim s As Shape
ActiveDocument.Unit = cdrMillimeter
可以试试改改这句ActiveDocument.ActivePage.ActiveLayer.CreateArtisticText(0, 0, wb, , , "arial", zt, False, False, , cdrLeftAlignment)
红色为字体名称。 这个看不懂,能整理方便的不 jialan75
你写的这个能私发下给我学习一下吗
期待你的回复
页:
[1]