weisuolong 发表于 2010-2-17 20:56:00

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

<p>Public Sub 导出文字()</p><p>&nbsp;&nbsp;&nbsp; Dim Excel As Excel.Application</p><p>&nbsp;&nbsp;&nbsp; Dim ExcelSheet As Object</p><p>&nbsp;&nbsp;&nbsp; Dim ExcelWorkbook As Object</p><p>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim LJ As String<br/>&nbsp;&nbsp;&nbsp; Dim NA As String<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim RowNum As Integer</p><p>&nbsp;&nbsp;&nbsp; Dim Header As Boolean</p><p>&nbsp;&nbsp;&nbsp; Dim elem As AcadEntity</p><p>&nbsp;&nbsp;&nbsp; Dim Arr()&nbsp; As String</p><p>&nbsp;&nbsp;&nbsp; Dim i As Integer<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '定义选择集和选择集元素<br/>&nbsp;&nbsp;&nbsp; Dim ssText As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim objSelected As AcadEntity<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;'安全地创建选择集<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; If Not IsNull(ThisDrawing.SelectionSets) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ssText = ThisDrawing.SelectionSets<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ssText.Delete&nbsp;&nbsp;&nbsp;&nbsp; '及时删除不用的选择集非常重要<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set ssText = ThisDrawing.SelectionSets.Add("Text")</p><p><br/>&nbsp;&nbsp;&nbsp; ' 获取本cad的路径和名字<br/>&nbsp;&nbsp;&nbsp; LJ = ThisDrawing.Path<br/>&nbsp;&nbsp;&nbsp; NA = ThisDrawing.Name<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' 启动 Excel。<br/>&nbsp;&nbsp;&nbsp; Set Excel = New Excel.Application</p><p>&nbsp;&nbsp;&nbsp; </p><p>&nbsp;&nbsp;&nbsp; ' 创建新的工作簿并查找活动电子表格。</p><p>&nbsp;&nbsp;&nbsp; Set ExcelWorkbook = Excel.Workbooks.Add</p><p>&nbsp;&nbsp;&nbsp; Set ExcelSheet = Excel.ActiveSheet<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ExcelWorkbook.SaveAs LJ &amp; "\" &amp; Left(NA, Len(NA) - 4) &amp; ".xls"<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </p><p>&nbsp;&nbsp;&nbsp;&nbsp; '提示用户在屏幕上选择文字<br/>&nbsp;&nbsp;&nbsp;&nbsp; 'MsgBox "请选择您想要导出的表格，然后按回车键", vbInformation, "提示"<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Utility.Prompt vbCr &amp; "请选择您想要导出的表格，然后按回车键"<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; '选择选择集，限定选择条件<br/>&nbsp;&nbsp;&nbsp;&nbsp; ssText.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' If ssText.Count = 0 Then Exit Sub<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '把块炸开<br/>&nbsp;&nbsp;&nbsp; For Each objSelected In ssText<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If LCase(objSelected.ObjectName) = "acdbblockreference" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objSelected.Explode<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; ' 循环选择的文字框内容<br/>&nbsp;&nbsp; i = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp; For Each objSelected In ssText<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If LCase(objSelected.ObjectName) = "acadtext" Or LCase(objSelected.ObjectName) = "acadMtext" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Arr(i) = objSelected.TextString<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i = i + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; ExcelWorkbook.Worksheets("sheet1").Active<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(Arr)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ExcelWorkbook.Worksheets("sheet1").Cells(i + 1, 1) = Arr(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("Text").Delete<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Excel.Application.Quit<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Application.Update<br/>End Sub</p><p><font color="#ff0000">这是我写的一个导出cad文字到excel第一列的代码&nbsp; 我是参照着几个写的 </font></p><p><font color="#ff0000">为什么保存的excel里没有数据哦。。。呜呜呜呜&nbsp;&nbsp; 大家帮帮忙</font></p><font color="#ff0000"></font>

weisuolong 发表于 2010-2-17 22:41:00

<p>大家帮帮忙啊</p><p>谢谢各位大侠了~~~~~~</p>

baby528 发表于 2010-2-20 21:02:00

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

gdzhou 发表于 2010-2-23 16:18:00

<p>选中的如果是块就炸开，，是指内容为文字的块？但是你炸开他也不在你现在的选择集中啊。。</p><p>再有，判断完是文字类型后，也没有看你有把ARR数组的维数重新定义什么啊，直接是赋不上的呀，所以再怎么导出是空的</p><p>另外以上解决完后，我想你导出的文字应该也是乱序的</p>
页: [1]
查看完整版本: [求助]请问我的程序错在哪里