CorelDRAW VBA 插件: 统计文本数量 视频教程
请用 1.25x 速度观看
B站视频:【CorelDRAW VBA 插件: 统计文本数量】
https://www.bilibili.com/video/BV1QK411a7Ch
----------------------------------------------
这是源码
这是网友的功能需求
这是完成后的效果
源码 核心代码
Sub 统计文本()
Dim s As Shape, sr As ShapeRange
Set sr = ActiveSelectionRange
Dim d As Variant, str As String
Set d = CreateObject("Scripting.dictionary")
For Each s In sr
If s.Type = cdrTextShape Then
str = s.text.Story.text
If d.Exists(str) = True Then
d.Item(str) = d.Item(str) + 1
Else
d.Add str, 1
End If
End If
Next s
End Sub
补充内容 (2024-1-26 09:28):
【CorelDRAW VBA插件: 文本统计功能 源码解析】 B站视频
https://www.bilibili.com/video/BV1164y1w7Tv
把源码解析的视频发上来了 这个好啊，修改一下还可用于删除重复的文本项 阑大师 有没有 获取所有图层的尺寸，然后再每个图层下方生成这个图层尺寸文本的代码 Long~~~ 发表于 2024-1-24 17:54
阑大师 有没有 获取所有图层的尺寸，然后再每个图层下方生成这个图层尺寸文本的代码 ...
这个代码应该可以实现的，虽然我也没有写过
你可以这样做，先在每层放置一个物件，然后你遍历图层，得到单独物件的尺寸
然后就再改改就可以了 本帖最后由 landboy 于 2024-1-24 20:10 编辑
Long~~~ 发表于 2024-1-24 17:54
阑大师 有没有 获取所有图层的尺寸，然后再每个图层下方生成这个图层尺寸文本的代码 ...
刚刚写了一个，你可以按这个看懂，再修改
Sub TraverseLayers()
ActiveDocument.Unit = cdrMillimeter
Dim sr As New ShapeRange
Dim l As layer, s As shape
For Each l In ActivePage.Layers
Set sr = Nothing
' 遍历图层中的每个对象
For Each s In l.Shapes.All
Debug.Print s.Name
sr.Add s
Next s
MsgBox l.Name & "图层: " & sr.SizeHeight & " x " & sr.SizeWidth
Next l
End Sub
HZMHYP 发表于 2024-1-24 19:57
统计文本？意思就是说只能统计未转曲的,转曲了的就不可以了是吧
转曲了就不是文本了，肯定通过这个方法是不行的 【CorelDRAW VBA插件: 文本统计功能 源码解析】 B站视频
https://www.bilibili.com/video/BV1164y1w7Tv
把源码解析的视频发上来了
插件质量太高了 benbinhduong 发表于 2024-1-29 16:32
插件质量太高了
谢谢观看和支持
页:
[1]
2