CorelDRAW VBA 给物件设置名称

CorelDRAW VBA 给物件设置名称

Public Function SetNames()
  Dim ssr As ShapeRange
  Set ssr = ActiveSelectionRange

#If VBA7 Then
  ssr.Sort " @shape1.left<@shape2.left"
#Else
' X4 不支持 ShapeRange.sort
#End If

  Dim text As String
  Dim lines() As String
  ' 提取文本信息，切割文本
  If ssr(1).Type = cdrTextShape Then
    If ssr(1).text.Type = cdrArtistic Then
      text = ssr(1).text.Story.text
      lines = Split(text, vbCr)
      ssr.Remove 1
  #If VBA7 Then
      ssr.Sort " @shape1.top>@shape2.top"
  #Else
  ' X4 不支持 ShapeRange.sort
  #End If
    End If
  Else
      MsgBox "请把多行文本放最左边"
      Exit Function
  End If
    
' Debug.Print ssr.Count, UBound(lines), LBound(lines)
' 给物件设置名称，用处:批量导出可以有一个名称
  i = 0
  If ssr.Count <= UBound(lines) + 1 Then
    For Each s In ssr
      s.Name = lines(i)
      i = i + 1
    Next s
  End If
  
  If ssr.Count <> UBound(lines) + 1 Then MsgBox "文本行:" & (UBound(lines) + 1) & vbNewLine & "右边物件:" & ssr.Count
  
End Function