VFP 愛用者社區 首頁 VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
 
 常見問題常見問題   搜尋搜尋   會員列表會員列表   會員群組會員群組   會員註冊會員註冊 
 個人資料個人資料   登入檢查您的私人訊息登入檢查您的私人訊息   登入登入 

DBF導入Excel的方法(轉貼)

 
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區
上一篇主題 :: 下一篇主題  
發表人 內容
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 就沒事, 不知其他人是否也是一樣
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 MSN Messenger
Erwin



註冊時間: 2003-03-28
文章: 97
來自: 台北

第 3 樓

發表發表於: 星期三 八月 27, 2003 12:03 am    文章主題: 引言回覆

我指的是Excel常會無緣無故當掉
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 MSN Messenger
elleryq



註冊時間: 2007-06-21
文章: 766


第 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 就好
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 MSN Messenger
奔跑的愛情



註冊時間: 2003-08-28
文章: 27


第 6 樓

發表發表於: 星期四 八月 28, 2003 5:51 pm    文章主題: 引言回覆

今天收穫可真不少啊!
_________________
delphi vf sql
回頂端
檢視會員個人資料 發送私人訊息 發送電子郵件 參觀發表人的個人網站 MSN Messenger
從之前的文章開始顯示:   
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區 所有的時間均為 台北時間 (GMT + 8 小時)
1頁(共1頁)

 
前往:  
無法 在這個版面發表文章
無法 在這個版面回覆文章
無法 在這個版面編輯文章
無法 在這個版面刪除文章
無法 在這個版面進行投票
無法 在這個版面附加檔案
無法 在這個版面下載檔案


Powered by phpBB © 2001, 2005 phpBB Group
正體中文語系由 phpbb-tw 維護製作