1
1

Text.bas 879 B

1234567891011121314151617181920212223242526272829303132333435
  1. Attribute VB_Name = "Module1"
  2. Sub 统计文本()
  3. Dim s As Shape, sr As ShapeRange
  4. Set sr = ActiveSelectionRange
  5. Dim d As Variant, str As String
  6. Set d = CreateObject("Scripting.dictionary")
  7. For Each s In sr
  8. If s.Type = cdrTextShape Then
  9. str = s.text.Story.text
  10. If d.Exists(str) = True Then
  11. d.Item(str) = d.Item(str) + 1
  12. Else
  13. d.Add str, 1
  14. End If
  15. End If
  16. Next s
  17. str = "文 本" & vbTab & vbTab & "数量" & vbNewLine
  18. a = d.keys: b = d.items
  19. For i = 0 To d.Count - 1
  20. str = str & a(i) & vbTab & b(i) & "条" & vbNewLine
  21. Next
  22. str = str & "合计总量:" & vbTab & vbTab & d.Count & "条" & vbNewLine
  23. Debug.Print str
  24. Dim s1 As Shape
  25. x = sr.FirstShape.LeftX - 100
  26. y = sr.FirstShape.TopY
  27. Set s1 = ActiveLayer.CreateParagraphText(x, y, x + 90, y - 150, str, Font:="华文中宋")
  28. End Sub