|
|
发表于 2009-11-14 08:21:05
|
显示全部楼层
来自： 中国
使用下面代码前,必须先在VBAIDE中引用EXCEL类库
; n; h$ `2 y8 M1 X% x- Sub TableToExcel()
7 `: `2 _1 D, @# G. F7 ?2 T6 c - Dim SS As AcadSelectionSet '声明一个选择集对象变量,用于从屏幕上选择CAD表格对象
% \6 d* e- u5 z: J - Dim FT(0) As Integer, FD(0) As Variant '声明选择集过滤器,用于限制从屏幕上选择的对象类型
$ P; F+ v$ j: ^2 Q - Dim T As AcadTable '声明一个CAD表格变量+ s7 T5 \, V5 O* m. w/ i
-
2 p" u [2 A; T: X - FT(0) = 0 '设置选择集过滤器,限制从屏幕上选择的对象仅限于CAD表格,而不是其它对象& K5 p! l. O1 t G! c, F! f
- FD(0) = "ACAD_TABLE"
& d H$ c6 ^! h: V1 p _. W" Z7 t - With ThisDrawing. M" M% h6 O7 T8 a& f6 C
- Set SS = .SelectionSets.Add("SS") '新建选择集
1 L; t5 I4 o3 s* d! W - On Error Resume Next* _# x# E" w5 W# B
- SS.SelectOnScreen FT, FD '从屏幕上选取CAD表格对象
) S. k# Z. b( r' c1 p' \, L - If Err Then Exit Sub
8 `8 S+ L7 r* M - If SS.Count > 0 Then '如果有效选取了表格对象
1 |0 V6 b- L, h- t& v! _( [ - Set T = SS.Item(SS.Count - 1)'如果选择了多个CAD表格对象,只对最后一个进行处理- Q& b! m( u3 M2 _
- * \' J: y6 F: A. x: h
- Dim E As New Excel.Application '声明并启动一个EXCEL进程* _" ~, L" u4 i, O
- Dim B As Workbook '声明一个EXCEL工作簿变量
0 O; E) q; N1 B7 _4 l8 _ - Dim I As Long, J As Long '循环变量: |/ a& ]1 V; o# h
- + w4 |% W) J% w$ U2 ~7 v7 s- O& A! U
- E.Visible = True '新启动的EXCEL进程对用户是可见的% t& V3 S: l G* r, R2 v E8 w
- Set B = E.Workbooks.Add '新建EXCEL工作簿- A- u' g# q) ^7 V
- For I = 0 To T.Rows - 1 '从CAD表格中逐单元格向EXCEL中复制
: s- F P+ _8 @9 Z3 | - For J = 0 To T.Columns - 1
' u1 z; h8 m8 q v! i% K - B.Sheets(1).Cells(I + 1, J + 1).Value = T.GetText(I, J)
! ^# h1 P2 t6 h6 C2 t - Next0 `( W9 U E; p$ z4 @( n* y
- Next: a( w6 J4 G+ T1 h# T9 r
- End If
' n% }+ o1 l6 G0 s) C5 k8 e - SS.Delete '删除用过的选择集
, E4 ~1 N. j% `# h; h# ~6 f) Q2 c" U - End With7 d: w( Z) V8 [* O. M* u
- End Sub
2 m7 F% n: F7 ?/ r7 Y/ A
|
|
发表于 2009-11-13 09:57:39
:victory: