求将明细表另存为excel的api函数

asd3149 · 发表于 2018-11-1 15:52:06

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

求将工程图的明细表另存为excel格式的api函数，或将明细表指定单元格数据读出写入excel也行，拜托了。

maichengyou · 发表于 2018-11-1 18:41:27

不是可以直接保存成excel吗？

asd3149 · 发表于 2018-11-2 08:48:26

maichengyou 发表于 2018-11-1 18:414 p7 E* W6 J$ T# C5 s( u7 K
不是可以直接保存成excel吗？

是呀，不过我是在做关于这个的二次开发插件，所以想通过代码自动实现这个过程。

lhl2008 · 发表于 2018-11-2 09:26:51

看看这一段程序

/ [* s( Q( E9 r+ X& @, C8 F: V
'----------------------------????BOM?????--------------------------
- j2 }& L- U# }
8 q' o. ^5 q5 b1 H7 D# W- x, d
Private Function TableToExcel(ByVal part As ModelDoc2, _
& Z2 T; T- N- L `6 K( w
ByVal inExcelName As String) As Boolean# s; @! ~8 F0 }( H# r
, m) a# h s* q. Q( y, F
Dim exCOUNT As Integer! y! U" P5 b; `) M ?$ Y* d
Dim swBomFeat As SldWorks.BomFeature' U N+ y2 S2 g
Dim vTableArr As Variant+ }7 T/ M) ^9 D+ d# n- L& U% A) o
Dim vTable As Variant: h: g' d T, _3 d; V
Dim swTable As Variant+ d g% y- p( L1 A
Dim swFeat As SldWorks.feature1 `4 L9 ?& P" E$ e
Dim swWeldmentCutListFeat As SldWorks.WeldmentCutListFeature
% L$ W, r0 B2 f6 m! ~, i" w
Dim vWeldCutListAnnotations As Variant! v; V6 T4 s( S, u- E
Dim WeldForI As Integer) [* @( n3 _# y5 a8 T$ \7 _
Dim WeldForJ As Integer
3 x5 \. ^# }+ e2 c
Dim a1 As Integer7 g* _% N* j( n# Y6 B4 m5 k9 H
Dim a2 As Integer
0 h7 T' v2 @, N0 {0 r$ Q: ~) j5 r
Dim s As String
9 v: @; I* C7 N3 }! o
Dim s1 As String
% ^) `$ b2 ^4 t# I5 k* g
Dim s2 As String6 W! Z5 Q% k6 C
Dim f1 As Single' ]3 I$ ~; L4 P M7 \( S
Dim f2 As Single
% b: s" b/ G. w" ^9 W7 ?* D C
Dim ExcelName As String
0 e2 i- _- `& k/ c3 k
Dim textName As String
6 M$ s; q8 I5 V6 T; l" e6 H
Dim oRes As New ADODB.Recordset
q- D. C$ f, ~
Dim oConn As New ADODB.Connection, Y+ X6 P- e# W! g4 H
Dim myTable() As String" A) |3 W2 B+ q5 [3 Q3 ]4 J \0 t- w
Dim bTableIn As Boolean '??????д??3 i( R1 ?$ a8 w; g
Dim c1 As String '????????, U: Y2 t: p( C7 T' h5 U3 `7 \
Dim SQLstr As String '??????SQL????
5 S \( g* b8 K/ L, k
* T% q3 w q0 g- O6 R
! n7 R; _" T$ {6 k e) |6 Y
On Error GoTo ToExcelErr
' {" J- E, t! R. w
bTableIn = False! k# \& _: c! G* s* b3 I3 E
ExcelName = inExcelName + ".xls"% G# ?% q) E @4 |3 ~
Set swFeat = part.FirstFeature
( B' r7 E% \2 S1 ~* _
Do While Not swFeat Is Nothing2 j/ W- Y5 I3 j, _# I( S# Q
If swFeat.GetTypeName = "BomFeat" Then
. \, ]1 |$ I+ x+ y7 ^4 u: B! i
'--------------- ????????????----------6 s1 n8 {9 C2 m5 _4 [
Set swBomFeat = swFeat.GetSpecificFeature2/ K! c9 v1 m' q8 F3 D, U
vTableArr = swBomFeat.GetTableAnnotations& G# D5 ^1 @4 r
For Each vTable In vTableArr
7 q$ b/ g- S% x! r# F% u1 t5 l
Set swTable = vTable; `) n' }, D6 X# s* |
exCOUNT = swTable.RowCount - 2
$ x" R0 z) R$ R; e3 w6 g
bTableIn = True6 W# a! K5 H3 ?9 _$ v! a5 p
ReDim myTable(0 To exCOUNT, 0 To 8) As String '????????, E. _) y) U4 J( H4 n ?9 n
For a1 = 0 To exCOUNT7 {/ s% K; t3 h X( {* f, f
For a2 = 0 To swTable.ColumnCount! ?1 ]2 `" s1 Q6 N- {" P
If IsNull(swTable.text(a1, a2)) Then1 ]8 A9 H A1 B6 O3 g) V/ C
s = " "
Y) H' S4 G$ j; T: G
Else. X- r; ~: J A; @4 y( ]
s = swTable.text(a1, a2), v( j3 M; ~$ @$ y- p
'If Len(s) = 0 Then s = " "/ c" d% z9 _4 j
End If& P( x; Y% O7 X9 g' z% m- P
myTable(a1, a2) = s
% |$ {0 {1 E U% i4 ^ E+ C
Next a24 `$ x* i# a R* l3 Y: `, A
Next a1
) t; f" L; |4 K
Next vTable8 f5 U6 B. l1 J7 a0 [8 x
End If* z. F2 `# J' \4 p! G8 o( C+ t
3 I3 ~) Q, _ h ?
If swFeat.GetTypeName = "WeldmentTableFeat" Then
; i. A/ ] Z1 o& E' ~
'-----------------?????и?????????-----------
0 O; f" }* v) x
Set swWeldmentCutListFeat = swFeat.GetSpecificFeature2
, p; m+ J" ^& F- ^; l
vWeldCutListAnnotations = swWeldmentCutListFeat.GetTableAnnotations
( M7 ^2 s0 b" v
WeldForJ = vWeldCutListAnnotations(0).ColumnCount - 1$ O I+ X+ n) r x$ K/ ~6 D
exCOUNT = vWeldCutListAnnotations(0).RowCount - 2+ }2 x5 m7 q' V
bTableIn = True
$ b) n; v4 x9 M1 K, e
ReDim myTable(0 To exCOUNT, 0 To 8) As String6 z! [( J+ {' n- S% e' g3 y
For a1 = 0 To exCOUNT
% X5 ~7 O$ d- r; s, O; q
For a2 = 0 To WeldForJ& |) M( N: @& Z( r: U
If IsNull(vWeldCutListAnnotations(0).text(a1, a2)) Then
8 @6 D4 X% U0 O" @- z/ f
s = " ", k& I' y2 w1 y3 S' a
Else
' {& {* X! @! q$ b- v
s = vWeldCutListAnnotations(0).text(a1, a2)
! i9 c0 `9 N% i- `; T& ]( }
'If Len(s) = 0 Then s = " "% J4 e: w# K9 ]$ n; R* u- h( p: o
End If
# m( W O- D0 s* J5 J5 B {
myTable(a1, a2) = s9 i! u' Q \8 Q
Next a2/ S, ^! d8 {9 \6 k+ a4 {
Next a1
! ]# |3 f5 l9 U- V. r* @6 y
# R1 C/ i5 V1 f, K# c( L7 X/ M
'????????????????????????????????(?????????????)???,???????????????????
: }2 O# m0 z2 a5 F8 V6 z8 `/ b
For a1 = 0 To exCOUNT8 A' Z! X- T7 ~: q" k4 G
s = myTable(a1, 6)8 ?9 f7 l+ l, S7 k, ~
s1 = myTable(a1, 7)7 `% m( }* c+ s' x: }4 f6 q5 S" R
If Len(Trim(s)) > 0 Then
, \* l8 m/ j2 |2 ^
If Len(Trim(s1)) = 0 Then6 ] \! L* S5 n
myTable(a1, 7) = "L=" & s$ g& D/ P7 ~7 p+ e9 D; r. ?/ J* q
Else8 w. @' q, V/ A' V' I4 h& U3 @
myTable(a1, 4) = myTable(a1, 5) + " L=" + s2 ?/ e: O9 }: k
End If
& k$ n: u! N& [- Q& F' z3 K% p3 a
End If
8 s" e, F- g4 a |* U
Next a1% w/ L" T5 f* Y9 u4 h% {
9 H( C- G0 Z( X9 s0 M
End If
1 Q& g }+ m ?
Set swFeat = swFeat.GetNextFeature
: \/ y4 c, e7 A1 e% I6 Q1 J7 j5 i) L
Loop
3 `8 z) E2 r; O* F( L
* k& B& u' I4 }- x- y/ X
If bTableIn Then '??????????????????????excel???
/ W- ] ~- M' s! M" I8 m
For a1 = 0 To exCOUNT '????????[3] X [5]?????0 r0 r( I) h# ^6 a* u
s = myTable(a1, 3)
, B; C U0 p* O r5 q1 n
s1 = myTable(a1, 5)0 ^2 U, v# v y
If Len(Trim(s)) > 0 Then
+ q3 B6 }( \$ C- W' E
f1 = CSng(s)/ V8 V3 h4 @- ~% @, Q
Else0 G; e7 N9 l9 E% }' f* i
f1 = 0
/ `3 w0 C" b- g/ {
End If
. m- [) s; t. x6 l! N2 K9 G
If Len(Trim(s1)) > 0 Then; o/ j6 `/ L& `. r2 E& h9 y
f2 = CSng(s1); u8 i S; T, o. O2 Z4 v% o+ x! F
Else
& V8 G% i6 ]6 Z& l4 Q6 ~6 B
f2 = 0! C9 c7 k D: T# H' z
End If( K# G+ C j& g% K1 H- i
myTable(a1, 6) = Format(f1 * f2, "##0.00")7 ?4 W7 P; T7 I% I5 }
Next a16 K$ e( Y4 B. ]8 {; Q: |
DeleteFile ExcelName '??????·???е?????????????0 B( G2 j4 P% S+ ]3 J. g
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExcelName & ";Extended Properties=""Excel 8.0;"""
; n j! E' \5 o0 A% _2 J5 ?$ m5 u
oRes.Open "CREATE TABLE a (IndexID TEXT,PCPNO TEXT,PCPName TEXT,Amount TEXT,MaterialName TEXT,Weight TEXT,Tweight TEXT,Remark TEXT,Source TEXT)", oConn, adOpenStatic% c- e6 h3 W; ]8 p2 ?+ r) ~
" j, E* u4 y8 u' v/ A- D( x
For a1 = exCOUNT To 0 Step -1( B( T( a! u5 W
s = "IndexID,PCPNO,PCPName,Amount,MaterialName,Weight,Tweight,Remark"
7 B2 d9 b: u7 P2 s
s2 = ""
% o: L5 x7 a/ R, u
c1 = """"% I: {+ }+ i) N* `
For a2 = 0 To 7
$ p. e7 t B3 v; P5 \2 _
myTable(a1, a2) = c1 & myTable(a1, a2) & c1% t# ]2 w" B8 Z. d7 B5 W$ z
s2 = s2 & myTable(a1, a2) & "," '???????????????% `) ]+ |- h: p" d
Next a28 h+ {# w8 a4 m/ e2 h/ S4 l3 w F8 O
s2 = Left(s2, Len(s2) - 1). q# b5 T% A9 D, l, V
SQLstr = "INSERT INTO a (" & s & ") VALUES (" & s2 & ")"$ m) R" W& s( y: O2 t5 L: s& \
oRes.Open SQLstr, oConn, adOpenStatic& z/ z8 Q8 E/ q5 _6 }: J% q
Next a19 r4 P' u1 E& Y6 _1 f
oConn.Close7 O% l9 z$ S1 H9 S* c2 V `
End If! ]6 m1 O& a" I, a$ Q
4 b5 |3 _0 O" s; M
1 |0 @* {. v: U F; Q8 D
TableToExcel = True
+ X- {8 c' j1 @, i% V4 m, C- G9 w* h
Exit Function
4 s1 ?) w1 N4 g3 `
ToExcelErr:7 D. {9 `5 ]7 b/ v( |
TableToExcel = False
& |0 w+ z5 q5 Y" e7 l1 m) H9 r1 ^# Z5 [
. B; V9 A5 K, |, f6 l F
End Function

复制代码

nizhen6007 · 发表于 2019-8-18 09:22:22

想法不错啊，楼上的代码可行吗？？

		自动登录	找回密码
密码			注册

通知

[求助] 求将明细表另存为excel的api函数

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。