|
|
发表于 2009-11-14 08:21:05
|
显示全部楼层
来自： 中国
使用下面代码前,必须先在VBAIDE中引用EXCEL类库
! v$ m2 _+ l$ Y" V' B, g% |: `- Sub TableToExcel()
7 ]7 [1 b8 o* x, p" Y; X - Dim SS As AcadSelectionSet '声明一个选择集对象变量,用于从屏幕上选择CAD表格对象
4 {" r6 J. j. k* e; s3 V! V - Dim FT(0) As Integer, FD(0) As Variant '声明选择集过滤器,用于限制从屏幕上选择的对象类型! ^) m- v! M9 M# d! _* l, O
- Dim T As AcadTable '声明一个CAD表格变量9 }$ E! S7 A! {# b% R
- 1 y& v5 U2 {1 S w: L5 q J$ f
- FT(0) = 0 '设置选择集过滤器,限制从屏幕上选择的对象仅限于CAD表格,而不是其它对象
4 y* ~( ?- o$ ?% L/ \- B- M: T - FD(0) = "ACAD_TABLE"
4 ^7 d2 R. C/ i( B3 E p - With ThisDrawing
2 O( i. z/ t3 `- H0 z - Set SS = .SelectionSets.Add("SS") '新建选择集
. ?; O* l' D3 _, o! N( i/ u - On Error Resume Next% W* y1 L8 r' ]% y! a) b! Q' b) o/ r
- SS.SelectOnScreen FT, FD '从屏幕上选取CAD表格对象/ ~. h/ M4 i; ], [$ [3 N! U! j0 x2 Z! W
- If Err Then Exit Sub
) ]9 Y; U( m7 h5 a - If SS.Count > 0 Then '如果有效选取了表格对象! Z: {. e4 S& i
- Set T = SS.Item(SS.Count - 1)'如果选择了多个CAD表格对象,只对最后一个进行处理9 F: O& J N8 m* E& q) ~
- 2 B* k( o7 g! |1 z4 a: z
- Dim E As New Excel.Application '声明并启动一个EXCEL进程
9 k# n1 n& p" y( H: L( m - Dim B As Workbook '声明一个EXCEL工作簿变量
$ v7 V1 P7 ]8 R0 z8 A8 o - Dim I As Long, J As Long '循环变量" ]$ [! w. y' D% m; A6 ^7 e) p
- ' W) Q9 v3 C7 c6 k3 s
- E.Visible = True '新启动的EXCEL进程对用户是可见的) d% F2 C8 c: r( Y
- Set B = E.Workbooks.Add '新建EXCEL工作簿, d9 U' q; L% w$ w
- For I = 0 To T.Rows - 1 '从CAD表格中逐单元格向EXCEL中复制
% u( s' U* _% ~ - For J = 0 To T.Columns - 1
( v) Q7 C2 j& l7 i - B.Sheets(1).Cells(I + 1, J + 1).Value = T.GetText(I, J)% G% T5 L# \% v
- Next
3 n2 w# u$ n6 Q - Next. H) Z7 F$ q8 |- h! W
- End If$ H E) ^: z5 i% A0 @, x
- SS.Delete '删除用过的选择集) W8 D" `8 p: L
- End With
3 v) W: E- U# ^8 z" S - End Sub! E. T6 P" l* l3 s" i0 t& Q
|
|
发表于 2009-11-13 09:57:39
:victory: