tshw311 发表于 2005-9-22 21:32:00

请教：CAD里的TXET文字如何转到EXCEL里？（下面的代码怎么改）

<P>我是初学者，想把CAD的TEXT文字转到EXCEL里，下面是这个想法的代码，但是调试时说是NEXT没有FOR，可能还有其他错误，不知道怎么改，还请高手帮忙指教指教！</P>
<P>Private Sub CommandButton4_Click()<BR>Dim Excel As Excel.Application<BR>&nbsp;&nbsp;&nbsp; Dim ExcelSheet&nbsp; As Object<BR>&nbsp;&nbsp;&nbsp; Dim ExcelWorkbook&nbsp; As Object<BR>&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp;&nbsp; Set Excel = GetObject(, "Excel.Application")<BR>&nbsp;&nbsp;&nbsp; If Err &lt;&gt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set Excel = CreateObject("Excel.Application")<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; Set ExcelWorkbook = Excel.Workbooks.Add<BR>&nbsp;&nbsp;&nbsp; Set ExcelSheet = Excel.ActiveSheet<BR>&nbsp;&nbsp;&nbsp; ExcelWorkbook.SaveAs "属性表.xls"<BR>Dim ssetobj As AcadSelectionSet<BR>Dim objselected As Object<BR>Dim i As Integer<BR>Dim arry1 As String<BR>Dim rownum As Integer<BR>Dim Count As Integer<BR>Dim arry2 As Variant<BR>Dim cnt As Integer<BR>Dim xcoordinate() As Double<BR>Dim ycoordinate() As Double<BR>Dim temp() As String<BR>Dim x As Integer<BR>Dim y As Integer<BR>On Error GoTo errcontrol<BR>Set ssetobj = ThisDrawing.SelectionSets.Add("mxb")<BR>Dim filtertype(0) As Integer<BR>Dim filterdata(0) As Variant<BR>filtertype(0) = 0<BR>filterdata(0) = "text"<BR>frmain.hide<BR>ssetobj.SelectOnScreen filtertype, filterdata<BR>ReDim xcoordinate(1 To ssetobj.Count), ycoordinate(1 To ssetobj.Count)<BR>ReDim temp(1 To ssetobj.Count)<BR>x = ssetobj.Count<BR>y = ssetobj.Count<BR>i = 0<BR>For Each objselected In ssetobj<BR>If TypeOf objselected Is AcadText Then<BR>arry1 = objselected.textString<BR>arry2 = objselected.InsertionPoint<BR>For cnt = 0 To ssetobj.Count - 1<BR>xcoordinate(cnt) = arry2(0)<BR>ycoordinate(cnt) = arry2(1)<BR>temp(cnt) = arry1<BR>Next cnt<BR>For Count = 1 To y<BR>For rownum = 1 To x<BR>i = i + 1<BR>ExcelSheet.cells(Count, rownum).Value = temp(i)<BR>Next rownum<BR>Next Count<BR>Next objselected<BR>&nbsp;&nbsp;&nbsp; Excel.Visible = True<BR>&nbsp;&nbsp;&nbsp; MsgBox "按'确定'键将关闭EXCEL的运行！"<BR>&nbsp;&nbsp;&nbsp; ExcelWorkbook.Save<BR>&nbsp;&nbsp;&nbsp; Excel.Application.Quit<BR>&nbsp;&nbsp;&nbsp; Set Excel = Nothing<BR>errcontrol:<BR>On Error Resume Next<BR>If Not IsNull(ThisDrawing.SelectionSets.Item("mxb")) Then<BR>ThisDrawing.SelectionSets("mxb").Delete<BR>End If<BR>End Sub</P>

songzhi 发表于 2005-9-22 22:15:00

<P>VBA 里面的NEXT好像不支持带上变量名称，你把它去掉试试看；</P>
<P>另外建议将objselected 定义为acadentity.</P>

tshw311 发表于 2005-9-26 17:06:00

好象还是不能通过

雪山飞狐_lzh 发表于 2005-9-26 17:21:00

<P>少了一个End if</P>

Jamme 发表于 2005-9-29 11:53:00

<P>和我联系，我可以帮你搞定。</P>
<P><FONT size=2>我的邮箱：<A href="mailto:wjingb@gmail.com" target="_blank" >wjingb@gmail.com</A>&nbsp;&nbsp; </FONT><FONT size=2>QQ：6376627</FONT></P>
<P>&nbsp;</P>

laurenjc 发表于 2005-10-14 10:36:00

把这句Next objselected中的objselected去掉就可以了
页: [1]
查看完整版本: 请教：CAD里的TXET文字如何转到EXCEL里？（下面的代码怎么改）