|
|
发表于 2009-11-14 08:21:05
|
显示全部楼层
来自: 中国
使用下面代码前,必须先在VBAIDE中引用EXCEL类库
0 }. P$ ]& y* Z( e- Sub TableToExcel(); ?# m3 V6 h( \3 w- e
- Dim SS As AcadSelectionSet '声明一个选择集对象变量,用于从屏幕上选择CAD表格对象& l: I; I! a4 W7 W0 t
- Dim FT(0) As Integer, FD(0) As Variant '声明选择集过滤器,用于限制从屏幕上选择的对象类型
0 [+ j) `& h. d0 j5 g - Dim T As AcadTable '声明一个CAD表格变量
) J1 k! W) A ^; O6 _' j -
! d" j8 f, x4 }" K- L) D - FT(0) = 0 '设置选择集过滤器,限制从屏幕上选择的对象仅限于CAD表格,而不是其它对象
8 K6 I3 i+ J1 l) y6 T# d - FD(0) = "ACAD_TABLE"
' m. R3 K- s2 W4 | - With ThisDrawing# |" @$ g" [& Y" j1 s" r! N
- Set SS = .SelectionSets.Add("SS") '新建选择集0 S7 I& y; Z6 q! K/ k5 D) o( ?7 [# e
- On Error Resume Next
% k# M/ F1 |2 @) w* W% W0 o6 `1 I+ w3 s& n - SS.SelectOnScreen FT, FD '从屏幕上选取CAD表格对象- q$ `( @: \0 m" S6 A
- If Err Then Exit Sub8 ~1 e; c2 j3 Y5 C! j4 y& h% v
- If SS.Count > 0 Then '如果有效选取了表格对象0 \2 r! }% J: g) y$ ?
- Set T = SS.Item(SS.Count - 1)'如果选择了多个CAD表格对象,只对最后一个进行处理7 r) b. G# {9 q% }" l& l- Q
- * n H! R( w. O
- Dim E As New Excel.Application '声明并启动一个EXCEL进程
/ H$ a9 G5 ]6 w' K4 \ - Dim B As Workbook '声明一个EXCEL工作簿变量
# Y0 j6 m1 m% f, f' j& t9 i - Dim I As Long, J As Long '循环变量% }4 I6 e0 p7 S1 {
-
) l i' i8 ~* z0 Q* B - E.Visible = True '新启动的EXCEL进程对用户是可见的# v0 V8 X; L& B+ I) {1 e
- Set B = E.Workbooks.Add '新建EXCEL工作簿
, e9 V1 R {2 }! @/ G7 j/ o1 Q$ z5 { - For I = 0 To T.Rows - 1 '从CAD表格中逐单元格向EXCEL中复制
! |8 f# ]$ S7 I( K - For J = 0 To T.Columns - 1+ O/ h$ R, b. W
- B.Sheets(1).Cells(I + 1, J + 1).Value = T.GetText(I, J)& Y: d$ ]+ }2 r3 @) R' y
- Next5 {" B" d/ s$ n I7 t
- Next
; ?' X/ z( P: f: o. n; D - End If+ U8 C' T# `: z2 v, v7 o
- SS.Delete '删除用过的选择集& r- Q# i r7 \4 j( E. t
- End With9 k5 I' }( j2 d# G7 @# k2 t4 R2 Q
- End Sub2 ]8 _- z e5 ^) _
复制代码 |
|