 |
VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
| 上一篇主題 :: 下一篇主題 |
| 發表人 |
內容 |
Ruey
註冊時間: 2003-03-12
文章: 1698
來自: tunglo
第 1 樓
|
 發表於: 星期二 八月 26, 2003 1:34 pm 文章主題: DBF導入Excel的方法(轉貼) |
 |
|
來源:vfptop gggg
VFP的DBF導出到EXECEL方法，供參考
你可用一下命令導出到EXECEL
Copy to filename type xls
也可用下列函授導出到EXECLE
| 代碼: |
****************************************
* 生成EXCEL檔 *
****************************************
Function ToExcel
Lparameters ExcelFile,OutField,PageSet,OtherSet
*ExcelFile-生成的EXCEL檔案名 (必需的參數)
*OutField-輸出的欄位 列1-欄位名 列2-標題 列3-寬度(=-1為自動) 列4-格式符 (可省略)
*PageSet-頁面�]置 列1-�]置的專案 列2-�]置的值 (可省略,PageSet的可用值請看�{式)
*OtherSet-其他�]置 (可省略,OtherSet的可用值請看�{式) , garfield註: 用傳�}的方式傳來�}列資料.
*使用本函數之前,請先切換到要輸出的工作區;其次只支援欄位,不支援運算式
*欄位�]不支援備註型和通用型
*如果用戶正在使用EXCEL編輯同名的檔,或者將要生成的EXCEL檔被佔用
*�]會造成�{式出錯,使用本函數之前建議關閉EXCEL
Do CASE
Case PARAMETERS()=1
Store null TO OutField,PageSet,OtherSet
Case PARAMETERS()=2
Store null TO PageSet,OtherSet
Case PARAMETERS()=3
Store null TO OtherSet
Endcase
Local i,OutFields,ExcelApp,ExcelAppRang
For i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))
OutField(i,1)=UPPER(ALLTRIM(OutField(i,1)))
Next
For i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))
PageSet(i,1)=UPPER(ALLTRIM(PageSet(i,1)))
Next
For i=1 TO IIF(TYPE("OtherSet(1)")="U" OR ISNULL(OtherSet),0,ALEN(OtherSet,1))
OtherSet(i,1)=UPPER(ALLTRIM(OtherSet(i,1)))
Next
OutFields=""
For i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))
OutFields=OutFields+IIF(EMPTY(OutFields),"",",")+OutField(i,1)
Next
If ISNULL(OutField) OR OutField(1)="AUTO_SET" AND OutField(2)="-1" &&生成EXCEL檔
Copy TO (ExcelFile) XL5
Else
Copy TO (ExcelFile) FIELDS &OutFields XL5
Endif
ExcelApp=CREATEOBJECT("Excel.application") &&訪問EXCEL
If Type("ExcelApp")#"O"
Wait CLEAR
Messagebox( "訪問Excel失敗！請檢查你的系統是否正確安裝 Excel 軟體！"+CHR(13)+CHR(13)+;
"但已經生成未帶格式的 Excel 檔:"+ExcelFile,48,"Excel不正常")
Return .f.
Endif
ExcelApp.Visible =.f.
ExcelApp.Caption ="生成EXCEL" &&標題
ExcelApp.Workbooks.Open(ExcelFile) &&打�}文件
ExcelApp.Workbooks(1).ActiveSheet.Name="Test" &&工作表名
ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).PageSetup &&頁面�]置物件
For i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))
Do CASE
Case PageSet(i,1)=UPPER("PaperSize") &&紙張類型
ExcelAppRang.PaperSize=PageSet(i,2)
Case PageSet(i,1)=UPPER("Orientation") &&列印方向
ExcelAppRang.Orientation=PageSet(i,2)
Case PageSet(i,1)=UPPER("TopMargin") &&頁頂空
ExcelAppRang.TopMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("BottomMargin") &&頁底空
ExcelAppRang.BottomMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("LeftMargin") &&頁左空
ExcelAppRang.LeftMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("RightMargin") &&頁右空
ExcelAppRang.RightMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("HeaderMargin") &&頁眉位置
ExcelAppRang.HeaderMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("FooterMargin") &&頁�}位置
ExcelAppRang.FooterMargin=PageSet(i,2)
Case PageSet(i,1)=UPPER("PrintTitleRows") &&行標題
ExcelAppRang.PrintTitleRows=PageSet(i,2)
Case PageSet(i,1)=UPPER("PrintTitleColumns") &&列標題
ExcelAppRang.PrintTitleColumns=PageSet(i,2)
Case PageSet(i,1)=UPPER("LeftHeader") &&左頁眉
ExcelAppRang.LeftHeader=PageSet(i,2)
Case PageSet(i,1)=UPPER("CenterHeader") &&中頁眉
ExcelAppRang.CenterHeader=PageSet(i,2)
Case PageSet(i,1)=UPPER("RightHeader") &&右頁眉
ExcelAppRang.RightHeader=PageSet(i,2)
Case PageSet(i,1)=UPPER("LeftFooter") &&左頁�}
ExcelAppRang.LeftFooter=PageSet(i,2)
Case PageSet(i,1)=UPPER("CenterFooter") &&中頁�}
ExcelAppRang.CenterFooter=PageSet(i,2)
Case PageSet(i,1)=UPPER("RightFooter") &&右頁�}
ExcelAppRang.RightFooter=PageSet(i,2)
Case PageSet(i,1)=UPPER("CenterHorizontally") &&頁面水平居中
ExcelAppRang.CenterHorizontally=PageSet(i,2)
Case PageSet(i,1)=UPPER("CenterVertically") &&頁面垂直居中
ExcelAppRang.CenterVertically=PageSet(i,2)
Endcase
Next
If ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1"
For i=1 TO FCOUNT()
If !ISNULL(OutField) AND ASCAN(OutField,UPPER(FIELD(i)))>0
ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(ASCAN(OutField,UPPER(FIELD(i)))+1) &&標題
*IF !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)) AND TYPE("OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)")="N" AND OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)#-1
* ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)
*ENDIF
If !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) AND !EMPTY(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) &&格式模版
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)
Endif
Endif
Next
Else
For i=1 TO ALEN(OutField,1)
If !ISNULL(OutField(i,2)) AND !EMPTY(OutField(i,2)) &&標題名稱
ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(i,2)
Endif
*IF !ISNULL(OutField(i,3)) AND TYPE("OutField(i,3)")="N" AND OutField(i,3)#-1 &&列寬
* ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(i,3)
*ENDIF
If !ISNULL(OutField(i,4)) AND !EMPTY(OutField(i,4)) &&格式模版
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(i,4)
Endif
Next
Endif
If ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&選擇標題行範圍
ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,FCOUNT()))
Else
ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,ALEN(OutField,1)))
Endif
ExcelAppRang.HorizontalAlignment=3 &&水平居中
ExcelAppRang.VerticalAlignment=2 &&垂直居中
ExcelAppRang.Font.Bold = .t.
If ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&選擇表格範圍
ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,FCOUNT()))
Else
ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;
ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,ALEN(OutField,1)))
Endif
******
* garfield註: OtherSet[ 要改變�]定值的種類名稱, �]定值 ]
If !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontSize"))#0 &&字體大小
ExcelAppRang.Font.Size=OtherSet(ASCAN(OtherSet,UPPER("FontSize"))+1)
Else
ExcelAppRang.Font.Size=10
Endif
If !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontName"))#0 &&字體
ExcelAppRang.Font.Name=OtherSet(ASCAN(OtherSet,UPPER("FontName"))+1)
Else
ExcelAppRang.Font.Name="宋體"
Endif
If !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("LineStyle"))#0 &&表格線的類型
Store OtherSet(ASCAN(OtherSet,UPPER("LineStyle"))+1) TO ;
ExcelAppRang.Borders(1).LineStyle,;
ExcelAppRang.Borders(2).LineStyle,;
ExcelAppRang.Borders(3).LineStyle,;
ExcelAppRang.Borders(4).LineStyle
Else
Store 1 TO ;
ExcelAppRang.Borders(1).LineStyle,;
ExcelAppRang.Borders(2).LineStyle,;
ExcelAppRang.Borders(3).LineStyle,;
ExcelAppRang.Borders(4).LineStyle
Endif
If !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("Weight"))#0 &&表格線的寬度,當LineStyle=1時有效
Store OtherSet(ASCAN(OtherSet,UPPER("Weight"))+1) TO ;
ExcelAppRang.Borders(1).Weight,;
ExcelAppRang.Borders(2).Weight,;
ExcelAppRang.Borders(3).Weight,;
ExcelAppRang.Borders(4).Weight
Else
Store 2 TO ;
ExcelAppRang.Borders(1).Weight,;
ExcelAppRang.Borders(2).Weight,;
ExcelAppRang.Borders(3).Weight,;
ExcelAppRang.Borders(4).Weight
Endif
If ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&列寬
For i=1 TO FCOUNT()
If !ISNULL(OutField) AND ASCAN(OutField,UPPER(FIELD(i)))>0 and OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)#-1
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)
Else
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit
Endif
Next
Else
For i=1 TO ALEN(OutField,1)
If OutField( i, 3)=-1
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit
Else
ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth=OutField( i, 3)
Endif
Next
Endif
ExcelApp.Workbooks(1).Save() &&保存
ExcelApp.Quit &&關閉
Release ExcelApp,ExcelAppRang
Return .t.
****************************************
|
_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!
學會VFP使用者社區的搜尋,Code才會更有趣~
############################# |
|
| 回頂端 |
|
 |
Erwin
註冊時間: 2003-03-28
文章: 97
來自: 台北
第 2 樓
|
| 發表於: 星期二 八月 26, 2003 4:11 pm 文章主題: |
|
|
我發現用copy to filename type xls 時的excel檔滿會當的
後來我都改用 copy to filename type xl5 就沒事, 不知其他人是否也是一樣 |
|
| 回頂端 |
|
|
Erwin
註冊時間: 2003-03-28
文章: 97
來自: 台北
第 3 樓
|
| 發表於: 星期三 八月 27, 2003 12:03 am 文章主題: |
|
|
| 我指的是Excel常會無緣無故當掉 |
|
| 回頂端 |
|
|
elleryq
註冊時間: 2007-06-21
文章: 768
第 4 樓
|
| 發表於: 星期三 八月 27, 2003 9:52 am 文章主題: |
|
|
在 Help 中有寫
type xls 是早期版本的 excel 格式
type xl5 則是 Excel 5.0
type xl8 則是 8.0 以後,不過這個我在 6.0 是試失敗的,雖然 Help 裡面有寫.
type csv 則是以逗號分隔的文字檔案,Excel 也可以讀取.
用 OLE Automation 的速度較慢是其缺點
不過可以綜合兩者的優點
先用 copy to 將資料先丟到 xls 檔案中
使用 getobject() 取得 excel instance 後,再用 OLE Automation 方式來畫線,填頁首頁尾等.... |
|
| 回頂端 |
|
|
Erwin
註冊時間: 2003-03-28
文章: 97
來自: 台北
第 5 樓
|
| 發表於: 星期三 八月 27, 2003 9:58 am 文章主題: |
|
|
我用 XL5 以後就不太會當了, 所以就不想搞得太麻煩
還是繼續用 COPY TO FILENAME XL5 就好 |
|
| 回頂端 |
|
|
奔跑的愛情
註冊時間: 2003-08-28
文章: 27
第 6 樓
|
| 發表於: 星期四 八月 28, 2003 5:51 pm 文章主題: |
|
|
今天收穫可真不少啊！
_________________
delphi vf sql |
|
| 回頂端 |
|
|
|
|
您 無法 在這個版面發表文章
您 無法 在這個版面回覆文章
您 無法 在這個版面編輯文章
您 無法 在這個版面刪除文章
您 無法 在這個版面進行投票
您 無法 在這個版面附加檔案
您 無法 在這個版面下載檔案
|
|
常見問題
搜尋
會員列表
會員群組
會員註冊
個人資料
登入檢查您的私人訊息
登入
