[求助]请问我的程序错在哪里

weisuolong

Public Sub 导出文字()

    Dim Excel As Excel.Application

    Dim ExcelSheet As Object

    Dim ExcelWorkbook As Object

    
    Dim LJ As String
    Dim NA As String
   
    Dim RowNum As Integer

    Dim Header As Boolean

    Dim elem As AcadEntity

    Dim Arr()  As String

    Dim i As Integer
   
    '定义选择集和选择集元素
    Dim ssText As AcadSelectionSet
    Dim objSelected As AcadEntity
   
 '安全地创建选择集
    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets) Then
        Set ssText = ThisDrawing.SelectionSets
        ssText.Delete     '及时删除不用的选择集非常重要
    End If
    Set ssText = ThisDrawing.SelectionSets.Add("Text")

    ' 获取本cad的路径和名字
    LJ = ThisDrawing.Path
    NA = ThisDrawing.Name
   
    ' 启动 Excel。
    Set Excel = New Excel.Application

   

    ' 创建新的工作簿并查找活动电子表格。

    Set ExcelWorkbook = Excel.Workbooks.Add

    Set ExcelSheet = Excel.ActiveSheet
   
    ExcelWorkbook.SaveAs LJ & "\" & Left(NA, Len(NA) - 4) & ".xls"
   
   
     

     '提示用户在屏幕上选择文字
     'MsgBox "请选择您想要导出的表格，然后按回车键", vbInformation, "提示"
    ThisDrawing.Utility.Prompt vbCr & "请选择您想要导出的表格，然后按回车键"
    
    
     '选择选择集，限定选择条件
     ssText.SelectOnScreen
    
    ' If ssText.Count = 0 Then Exit Sub
   
   
   
    '把块炸开
    For Each objSelected In ssText
                    
                     If LCase(objSelected.ObjectName) = "acdbblockreference" Then
                                 objSelected.Explode
                     End If
    Next
  
   
   
   ' 循环选择的文字框内容
   i = 0
     For Each objSelected In ssText
    
       If LCase(objSelected.ObjectName) = "acadtext" Or LCase(objSelected.ObjectName) = "acadMtext" Then
       Arr(i) = objSelected.TextString
       i = i + 1
       End If
      
     Next
    
    
   ExcelWorkbook.Worksheets("sheet1").Active
    
     For i = 0 To UBound(Arr)
      ExcelWorkbook.Worksheets("sheet1").Cells(i + 1, 1) = Arr(i)
     Next
    
         
  
  
  
    ThisDrawing.SelectionSets.Item("Text").Delete
   
    Excel.Application.Quit
    ThisDrawing.Application.Update
End Sub

这是我写的一个导出cad文字到excel第一列的代码  我是参照着几个写的

为什么保存的excel里没有数据哦。。。呜呜呜呜   大家帮帮忙

weisuolong

大家帮帮忙啊

谢谢各位大侠了~~~~~~

baby528

用调试模式看看哪里出错了，我都是写在正在运行的Excel文件中，还没有直接保存过

gdzhou

选中的如果是块就炸开，，是指内容为文字的块？但是你炸开他也不在你现在的选择集中啊。。

再有，判断完是文字类型后，也没有看你有把ARR数组的维数重新定义什么啊，直接是赋不上的呀，所以再怎么导出是空的

另外以上解决完后，我想你导出的文字应该也是乱序的