 |
VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
| 上一篇主題 :: 下一篇主題 |
| 發表人 |
內容 |
Ruey
註冊時間: 2003-03-12
文章: 1698
來自: tunglo
第 1 樓
|
 發表於: 星期三 四月 21, 2004 4:17 pm 文章主題: Copy2xls(轉貼) |
 |
|
轉出資料到 Excel
作者:Mike Gagnon (mike.gagnon@slpcanada.com)
| 代碼: | * Program...........: Copy2xls.prg
* Author............: Daniel Gramunt
* Project...........: common
* Created...........: 11.10.2000 17:25:06
*) Description.......: Replacement for the native COPY TO TYPE XL5
command.
*) : Excel 5 and Excel 95 have a limit of 16,383 rows
per worksheet.
*) : The limit in Excel 97 and Excel 2000 is 65,536
rows.
*) : Since there is no TYPE XL8 command, VFP copies
only the first 16,383 records.
*) :
*) : This program works around this limitation and
allows to copy as many
*) : records as the Excel version used on the user's
machine supports.
*) :
*) : The solution is very simple:
*) : 1. COPY TO TYPE CSV
*) : 2. Open CSV file and SaveAs(tcExcelFile) using
Automation
*) :
*) : Assumes that MS Excel (Excel 97 or higher) is
installed on the
*) : user's machine (well, it will also work with
Excel 5.0 and 95, but of
*) : course the limit of 16,383 will apply).
*) :
*) : Returns the number of exported records if
successful, otherwise:
*) : -1 = parameter missing or wrong type
*) : -2 = no table open in current workarea
*) : -3 = number of max. Excel rows exceeded
*) : -4 = user didn't want to overwrite existing
Excel file (SET SAFETY = ON)
*) :
*) : Performance note: The COPY TO command in VFP
works very fast compared to
*) : anything that involves
automation. However, since we use
*) : automation only to open the
exported file and to save it
*) : under a different format, there
is almost no performance
*) : penalty.
*) :
* Calling Samples...: Copy2Xls("c:\temp\bidon.xls")
* Parameter List....: tcExcelFile - Path\Filename of the Excel
file to be created.
* : [tlDbf] - Specifies which TYPE to use
with the COPY TO command:
* : .t. = TYPE FOX2X
* : .f. = TYPE CSV
* : Default = .f.
* : There are some differences
between FOX2X and CSV. Depending on the
* : data to be copied, you can now
specify which method to use.
* : See the remarks below for a
description of the differences between
* : the two methods.
* : [tlNoFieldNames] - By default, the first row of
the Excel sheet contains the
* : fieldnames. If tlNoFieldNames
is .t., the Excel sheet contains
* : only the data.
* :
* Major change list.: 26.10.2000: COPY TO FOX2X and SaveAs(<
tcExcelFile >) instead of
* : "assembling" individual Excel files.
* : Thanks to an idea from etin
Bas z on the UT
* : 12.04.2000: COPY TO CSV instead of FOX2X.
* : FOX2X has the following limitations:
* : - problem with codepage 850 (e.g.
character " ")
* : - doesn't support long fieldnames
(work around would be easy though)
* : - doesn't support datetime
* : CSV has none of the above problems,
but has some other
* : limitations:
* : - logical fields are translated into
F/T vs FALSE/TRUE.
* : This isn't a problem, but to keep
things consistent, we
* : don't use the native COPY TO TYPE
XL5 anymore for tables
* : with a record count below the
limitation.
* : - If a character field contains only
digits and the value
* : contains leading zeros, Excel
translates this into a
* : numeric value (e.g. "00000100" =>
100). This could be a
* : problem, specially if the field is
a PK and you later
* : import the Excel file back into
VFP.
* : - [New 04.06.2001]
* : If a character field contains
double quotes and/or commas,
* : the result gets messed-up:
* :
* : - VFP
------------------------------------------ - Excel
-------------------------------------------------------------------- -
Remarks -----------------------------------
* : cDesc1 cDesc2
cDesc1 cDesc2
Next Field
* : ------------------------
----------------------- -----------------------------------------
----------------------- ----------
---------------------------------------------
* : Rotating seal 1"
Bibus:Deublin model 55 Rotating seal 1",Bibus:Deublin model 55"
cDesc2 appended to cDesc1, all other fields
* :
are shifted to the left by one
* :
* : Bush 7/16"
D=15/4,75 L=86,4 Bush 7/16",D=15/4
75 L=86 4" part of cDesc2 appended to cDesc1
(text until
* :
1st comma), the remaining text until the next
* :
comma stays in cDesc2, the text after the
* :
second comma is moved to field3, after that,
* :
every field is shifted to the right by one
* :
* : 04.06.2001 New parameters < tlDbf > and <
tlNoFieldNames > added
*------------------------------------------------------------------------
--------------------------
LPARAMETER tcExcelFile, tlDbf, tlNoFieldNames
#INCLUDE FoxPro.h
#DEFINE xlWorkbookNormal -4143 && used by SaveAs() to save in
current Excel version
#DEFINE ccErrorNoParameter "Parameter < tcExcelFile > : Parameter
missing or wrong type (Expecting 'C')"
#DEFINE ccErrorNoTableOpen "No table is open in the current workarea"
#DEFINE ccErrorToManyRows "Number of records (" + ;
ALLTRIM(TRANSFORM(lnRecords,
"999,999,999")) +;
") exceed max. number of Excel rows (" -;
ALLTRIM(TRANSFORM(lnXlsMaxNumberOfRows,
"999,999,999"))+;
")"
*-- check parameter
IF VARTYPE(tcExcelFile) <> "C" OR EMPTY(tcExcelFile)
??CHR(7)
WAIT WINDOW NOWAIT ccErrorNoParameter
RETURN -1
ELSE
tcExcelFile = ForceExt(tcExcelFile, "XLS")
ENDIF
*-- make sure that we have a table/cursor in the selected workarea
IF EMPTY(ALIAS())
??CHR(7)
WAIT WINDOW NOWAIT ccErrorNoTableOpen
RETURN -2
ENDIF
LOCAL loXls, lnXlsMaxNumberOfRows, lnRecords, lnRetVal, lcTempDbfFile
loXls = CREATEOBJECT("excel.application")
*-- suppress Excel alerts and messages (similar to SET SAFETY OFF)
loXls.DisplayAlerts = .f.
*-- get number of max. rows from Excel. Before we can count the rows in
a
*-- worksheet, we need to add a workbook.
loXls.workbooks.add()
lnXlsMaxNumberOfRows = loXls.ActiveWorkBook.ActiveSheet.Rows.Count - 1
&& 1 header row
lnRecords = RECCOUNT()
*-- check if the number or records exceeds Excel's limit
IF lnRecords > lnXlsMaxNumberOfRows
??CHR(7)
WAIT WINDOW NOWAIT ccErrorToManyRows
*-- close Excel
loXls.application.quit()
RETURN -3
ENDIF
*-- respect SET SAFETY
IF SET("SAFETY") = "ON" AND FILE(tcExcelFile)
IF MESSAGEBOX(tcExcelFile + " already exists, overwrite it?",;
MB YESNO + MB ICONQUESTION + MB DEFBUTTON2) = IDNO
*-- user selected < No > so we bail out
*-- close Excel
loXls.application.quit()
RETURN -4
ENDIF
ENDIF
IF tlDbf
lcTempDbfFile = AddBs(SYS(2023)) + SYS(3) + ".DBF"
COPY TO (lcTempDbfFile) TYPE FOX2X AS 850
ELSE
lcTempDbfFile = AddBs(SYS(2023)) + SYS(3) + ".CSV"
COPY TO (lcTempDbfFile) TYPE CSV
ENDIF
lnRetVal = TALLY
*-- open exported CSV file
loXls.Application.Workbooks.Open(lcTempDbfFile)
IF tlNoFieldNames
loXls.ActiveSheet.Range("1:1").delete
ENDIF
*-- save as Excel file
loXls.ActiveSheet.saveAs(tcExcelFile, xlWorkbookNormal)
*-- delete CSV file
IF FILE(lcTempDbfFile)
DELETE FILE (lcTempDbfFile)
ENDIF
*-- close Excel
loXls.application.quit()
RETURN lnRetVal |
_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!
學會VFP使用者社區的搜尋,Code才會更有趣~
############################# |
|
| 回頂端 |
|
 |
Ruey
註冊時間: 2003-03-12
文章: 1698
來自: tunglo
第 2 樓
|
| 發表於: 星期三 四月 21, 2004 4:32 pm 文章主題: |
|
|
懶人的方法:
select "yourtable"
EXPORT TO c:\yourfile.xls TYPE XL5 FIELDS last_name, first_name, ... ALL
_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!
學會VFP使用者社區的搜尋,Code才會更有趣~
############################# |
|
| 回頂端 |
|
|
|
|
您 無法 在這個版面發表文章
您 無法 在這個版面回覆文章
您 無法 在這個版面編輯文章
您 無法 在這個版面刪除文章
您 無法 在這個版面進行投票
您 無法 在這個版面附加檔案
您 無法 在這個版面下載檔案
|
|
常見問題
搜尋
會員列表
會員群組
會員註冊
個人資料
登入檢查您的私人訊息
登入
