VFP 愛用者社區 :: 觀看文章 - (轉貼)VFP TO WPS Offices

VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.

常見問題

搜尋

會員列表

會員群組

會員註冊

個人資料

登入檢查您的私人訊息

登入

(轉貼)VFP TO WPS Offices

VFP 愛用者社區首頁 -> VFP 討論區

發表人

內容

goto-dream

註冊時間: 2004-05-11
文章: 909

第 1 樓

發表於: 星期六一月 01, 2011 3:40 pm 文章主題: (轉貼)VFP TO WPS Offices

來源 http://www.meizvfp.com/bbs/dispbbs.asp?BoardID=2&replyID=20232&ID=82425&skin=1
huangdehua 梅子論壇

代碼:

LOCAL num,nFldCount,LX,Exl,ZLK,ZLS,ZJZ,Lerr_pd
Lerr_pd=.F.
IF VARTYPE(BM)<>'C' OR EMPTY(BM)
BM=DBF()
IF EMPTY(BM)
=MESSAGEBOX("沒有資料！", 16, "提示")
RETURN
ENDI
ENDIF
IF VARTYPE(BT)<>'C' OR EMPTY(BT)
BT='WPS文檔'
ENDIF
IF VARTYPE(FX)<>'N' OR BETWEEN(FX,1,2)
FX=1
ENDIF
IF !USED(BM)
=MESSAGEBOX("沒有打�}表！"+BM, 16, "提示")
RETURN
ENDIF
SELECT &BM
num=RECCOUNT()
IF NUM=0
=MESSAGEBOX("沒有資料！", 16, "提示")
RETURN
ENDI
THIS.Jdt('正在向WPS導出資料,請稍候...',num,0)
ON error Lerr_pd=.t.
eole=createobject('ET.APPLICATION')&&新打�}一個ET表
ON ERROR
IF Lerr_pd=.t.
=MESSAGEBOX("WPS物件創建失敗，�{式將中止！", 16, "提示")
THIS.Visible=.F.
RETU .f.
ENDI

eole.visible=.t.
eole.Workbooks.add &&添�[�[sheet1表
eole.Worksheets(1).Activate &&啟動
*!* eole.Worksheets('sheet1').Activate
*!* eole.Worksheets(1).cells[1,1].value='你好'
*!* eole.Worksheets('sheet1').cells[1,1].value='你好'
*!* eole.worksheets['sheet2'].Rows[1].select &&先選中一行，即明確要刪除哪一行
*!* eole.Worksheets['sheet2'].Rows[1].Insert(-4121)&&這是插入行，具體為什麼這樣寫，

eole.ActiveSheet.PageSetup.Orientation = FX &&橫向
** �]置單格寬與高
*!* With eole.ActiveWorkbook.ActiveSheet.Range("A1", "F10")
*!* .RowHeight = 20
*!* .ColumnWidth =10
*!* EndWith
*!* -----�]置單格邊框----------
*!* With eole.ActiveWorkbook.ActiveSheet.Range("A1", "F10").Borders
*!* .LineStyle=1&&連續線
*!* .Weight =2&&細線 1-虛線
*!* .Color = RGB(0, 0, 0)&&黑色
*!* ENDWITH
eole.Caption=BT &&更改Excel標題欄
eole.Cells.Select&&選擇整張表
eole.Selection.Font.Size = 10&&�]置整表默�{字體大小為10
*!* eole.Range("A1:F1").Font.Size = 14 '�]置為45號字
eole.Selection.Font.Bold ='T'
*!* eole.Range("A1:F1").Font.Bold = True '�]置為粗體
*!* eole.Range("A1:F1").HorizontalAlignment=1 && 1 左齊 3 居中 4 右齊
*!* eole.Range("A4:F4").Merge&&合併單格
*!* OLE.Range("B2:F2").NumberFormatLocal = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * " '單元格格式
*!*
*!* '----------定義頁眉頁�},橫向----------------------
*!* OLE.ActiveSheet.PageSetup.RightHeader = "頁眉右邊"
*!* OLE.ActiveSheet.PageSetup.LeftFooter = "&10製錶人："
*!* OLE.ActiveSheet.PageSetup.CenterFooter = "&10復核人："
*!* OLE.ActiveSheet.PageSetup.Orientation = 2 '橫向

****根據欄位數求出最後一列
nFldCount = AFIELDS(aFldList,BM) &&把當前表的結構資訊存放在一個�}列中，並且返回表的欄位數。1 欄位名 2 欄位類型 3 欄位寬度
LX=FLOOR(nFldCount/26)
Exl=MOD(nFldCount,26)
IF Exl=0
LX=LX-1
Exl=26
ENDIF
Exl=SUBSTR('ABCDEFGHIJKLMNOPQRSTUVWXYZ',LX,1)+SUBSTR('ABCDEFGHIJKLMNOPQRSTUVWXYZ',Exl,1)
*******
go top
**************
FOR i = 1 TO nFldCount
DO CASE
CASE aFldList[i, 2] = "M" &&備註型
eole.Columns(I).WrapText = .F.
CASE INLIST(aFldList[i, 2], "N", "F", "I", "B", "Y") && Y貨幣型 B雙精度型 F浮點型 N數值型
eole.Columns(I).NumberFormatLocal = "0.00"
CASE aFldList[i, 2] = "I"&& 整型
eole.Columns(I).NumberFormatLocal = "0"
CASE aFldList[i, 2] = "L"&& 邏輯型
CASE aFldList[i, 2] = "G"&& 通用型
OTHERWISE
eole.Columns(I).NumberFormatLocal = "@" &&字元型
ENDC
eole.Cells(3,i).Value = aFldList[i,1]
ENDFOR
SELECT &bm
num=RECCOUNT()
IF FX=1
DO CASE
CASE num<10
eole.selection.rowheight=25
CASE num<15
eole.selection.rowheight=23
CASE num<20
eole.selection.rowheight=20
OTHERWISE
eole.selection.rowheight=18
ENDCASE
ELSE
DO CASE
CASE num<10
eole.selection.rowheight=25
CASE num<15
eole.selection.rowheight=23
CASE num<20
eole.selection.rowheight=20
OTHERWISE
eole.selection.rowheight=18
ENDCASE
ENDI
go top
SCAN
J=RECNO()
*!* THIS.Jdt('正在向Excel導出資料,請稍候...',num,J)
FOR i =1 TO nFldCount
vValue = .NULL.
IF AT(aFldList[i, 2], "CDLMNFIBYT") = 0
LOOP
ENDIF
cFldName = aFldList[i, 1]
vValue = EVALUATE(cFldName) && 計算字元運算式的值並返回結果。返回值:字元型、數值型、貨幣型、日期型、日期時間型、邏輯型或備註型
DO CASE
CASE aFldList[i, 2] = "C" && 字元/字串
vValue = RTRIM(vValue)
CASE aFldList[i, 2] = "D" && 日期
vValue = DTOC(vValue)
CASE aFldList[i, 2] = "T" && 日期時間
vValue = TTOC(vValue)
CASE INLIST(aFldList[i, 2], "N", "F", "I", "B", "Y") && 數值
CASE aFldList[i, 2] = "L" && 邏輯
CASE aFldList[i, 2] = "M" && 備註型
OTHERWISE
vValue = .NULL.
ENDCASE
IF VARTYPE(vValue) = "C" AND EMPTY(vValue)
LOOP
ENDIF
****數字為0不導出
IF VARTYPE(vValue) = "N" AND vValue =0
vValue = .NULL.
ENDIF
*******
IF NOT ISNULL(vValue)
eole.Cells(J+3, i).Value = vValue
ENDIF
ENDFOR
ENDSCAN
********至些資料導出結束,下面進行相關�]置
WITH eole.RANGE('A3:'+Exl+ALLTRIM(STR(J+3))).BORDERS &&eole.ActiveWorkbook.ActiveSheet.Range("A1", "F10").Borders
.LINESTYLE=1
.Weight =2&&細線 1-虛線
.Color = RGB(0, 0, 0)&&黑色
ENDWITH
eole.columns("A:"+Exl).autoFit &&自動適應寬度
*!* With wpsapp.ActiveWorkbook.ActiveSheet.Range("A1", "F10")
*!* .RowHeight = 20&&行高
*!* .ColumnWidth =10&&列寬
*!* EndWith

_________________
福隆昌淨水有限公司--淨水器的專家,淨水器,飲水機,濾心!!

想了解更多，您可上幸福雞湯組.找尋!!丁澐瑄.老師.

　　　　　　　　　　愛作夢

回頂端

從之前的文章開始顯示:

	VFP 愛用者社區首頁 -> VFP 討論區	所有的時間均為台北時間 (GMT + 8 小時)
第1頁(共1頁)

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