D5 Excel 轉出 excel Source_code ---- water |
|
|
|
water
初階會員   發表：90 回覆：89 積分：35 註冊：2003-07-07 發送簡訊給我 |
感謝前陣子 各位先進幫忙 ' 在此分享 ADO excel source-code
此 source_code 比發表區有小部分顯示功能 update 網友對 Delphi control Ecxel 有不清楚的地方.
可看我發問的問題(都是基本入門的問題)
unit Unit1; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, ADODB, Grids, DBGrids, comobj ,Excel2000 ; type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Button2: TButton;
Label5: TLabel;
Label6: TLabel;
Edit3: TEdit;
Label7: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit3KeyPress(Sender: TObject; var Key: Char);
procedure Button3Click(Sender: TObject); private
{ Private declarations }
public end; var
Form1: TForm1; Ms_ExcelR1 ,Ms_ExcelR2 ,Ms_ExcelW3 ,Ms_ExcelW4 : String; // 檔案
Ms_ExcelAP1,Ms_ExcelAP2,Ms_ExcelAP3,Ms_ExcelAP4 : Variant;
Ms_ExcelWB1,Ms_ExcelWB2,Ms_ExcelWB3,Ms_ExcelWB4 : Variant; M_BB_Row,M_CC_Row,M_DD_Row : integer ; // 轉換行數
M_Total_Line : integer ; // 產線判斷 Ms_dir : String ; // 目錄路徑 function Scan_BB_Excel( M_Workno:string ):boolean;
function Write_CC_Excel():boolean;
function Chang_CC_Excel_Barcode():boolean; implementation uses Unit2; {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.TEXT:=FormatDateTime('YYYY/M/D',Now); // 始日
Edit2.TEXT:=FormatDateTime('YYYY/M/D',Now); // 終日 Ms_ExcelW4:='setup.xls';
Ms_dir :=GetCurrentDir(); // 取得目前程式位置
Ms_ExcelW4:=Ms_Dir '\' Ms_ExcelW4 ; // 路徑 檔名 // test setup.xls 設定檔
try
Ms_ExcelAP4 := CreateOleObject('Excel.Application');
Ms_ExcelWB4 := Ms_ExcelAP4.WorkBooks.OPEN(Ms_ExcelW4); // 舊檔 開啟
except
Ms_ExcelWB4 := Ms_ExcelAP4.WorkBooks.add; // 新檔 重建
Ms_ExcelAP4.cells[1,1].value := '生產資料檔路徑';
Ms_ExcelAP4.cells[1,2].value := '工單明細檔路徑';
Ms_ExcelWB4.SaveAS(Ms_ExcelW4); // save
end; Ms_ExcelAP4.Worksheets[1].activate; M_AA_File := Ms_ExcelAP4.cells[2,1].value; // 讀生產明細檔 路徑
M_BB_File := Ms_ExcelAP4.cells[2,2].value; // 讀訂單明細檔 路徑 Ms_ExcelAP4.ActiveWorkBook.Saved := True; // 不存檔
Ms_ExcelAP4.Application.Quit; // 離開 end; procedure TForm1.Button1Click(Sender: TObject);
var
// Ms_dir : String ; // 目錄路徑 M_date,MM_date : string ; M_Total_date,M_Times : integer ; // 日期次數 M_FCell_date : Variant ; // 搜尋日期_cell
M_WorkNO : STRING ; // 工單編號 i,j : integer ; BEGIN
j:=0;
// Ms_dir :=GetCurrentDir(); // 取得目前程式位置
// Ms_ExcelR1 := 'AA.xls' ; // 工單生產排程
// Ms_ExcelR2 := 'BB.xls' ; // 工單詳細資料
Ms_ExcelW3 := 'CC.xls' ; // 轉出資料 // Ms_ExcelR1 :=Ms_Dir '\' Ms_ExcelR1 ; // 路徑 檔名
// Ms_ExcelR2 :=Ms_Dir '\' Ms_ExcelR2 ;
Ms_ExcelR1 := M_AA_File ; // 路徑 檔名
Ms_ExcelR2 := M_BB_File ;
Ms_ExcelW3 := Ms_Dir '\' Ms_ExcelW3 ; // test 工單排程檔
try
Ms_ExcelAP1 := CreateOleObject('Excel.Application');
Ms_ExcelWB1 := Ms_ExcelAP1.WorkBooks.OPEN(Ms_ExcelR1,ReadOnly := True);
// Ms_ExcelWB1 := Ms_ExcelAP1.WorkBooks.OPEN(Ms_ExcelR1);
Ms_ExcelAP1.Worksheets[1].select;
except
MessageDlg('Can''t Open Excel AA !!',mtWarning,[mbOK],0);
Exit;
end;
// test 工單明細檔
try
Ms_ExcelAP2 := CreateOleObject('Excel.Application');
Ms_ExcelWB2 := Ms_ExcelAP2.WorkBooks.OPEN(Ms_ExcelR2,ReadOnly:=True);
// Ms_ExcelWB2 := Ms_ExcelAP2.WorkBooks.OPEN(Ms_ExcelR2);
Ms_ExcelAP2.Worksheets[1].select;
except
MessageDlg('Can''t Open Excel BB !!',mtWarning,[mbOK],0);
Exit;
end;
// test 轉出資料檔
try
Ms_ExcelAP3 := CreateOleObject('Excel.Application');
Ms_ExcelWB3 := Ms_ExcelAP3.WorkBooks.OPEN(Ms_ExcelW3); Ms_ExcelAP3.Worksheets[3].select; // 舊檔 clear sheet1
Ms_ExcelAP3.ActiveSheet.cells.clear;
Ms_ExcelAP3.Worksheets[2].select;
Ms_ExcelAP3.ActiveSheet.cells.clear;
Ms_ExcelAP3.Worksheets[1].select;
Ms_ExcelAP3.ActiveSheet.cells.clear;
except
Ms_ExcelWB3 := Ms_ExcelAP3.WorkBooks.add; // 新檔 重建
Ms_ExcelWB3.SaveAS(Ms_ExcelW3);
end; // MessageDlg('files open ok !!',mtWarning,[mbOK],0); for M_Total_Line:=1 to 3 do // 生產線
begin
Ms_ExcelAP1.Worksheets[M_Total_Line].activate;
Ms_ExcelAP3.Worksheets[M_Total_Line].activate;
M_CC_Row:=1; // CC_Exl 轉出檔行數紀錄 M_Total_date:=ROUND(StrtoDateTime( Edit2.Text) - StrtoDateTime(Edit1.Text)); for M_Times:=0 to M_Total_date do // 日期迴路
begin
M_date := FormatDateTime('m/d',StrtoDateTime(Edit1.Text) M_Times); Ms_ExcelAP3.cells[M_CC_Row,1].value:=M_date; // 存日期
M_CC_Row:=M_CC_Row 1;
// 存標題
M_BB_Row:=2;
Write_CC_Excel(); M_FCell_date := Ms_ExcelAP1.cells.Find(M_date); // 搜尋日期
if VarIsEmpty(M_FCell_date) then // 判斷找到
begin
ShowMessage(M_date ' not Found !!! ');
exit;
end; // MessageDlg('當日生產工單資料 找到 !! ' mm_date,mtWarning,[mbOK],0); for i:=1 to 300 do // 搜尋工單
begin
M_WorkNO:=COPY(Ms_ExcelAP1.cells[i,M_FCell_date.Column].value,1,10) ; if (copy(M_WorkNO,1,2)='BW') AND (copy(M_WorkNO,4,1)='-') then
begin
// MessageDlg('日:' M_date ' 工單:' M_WorkNO mm_date,mtWarning,[mbOK],0);
Scan_BB_Excel( M_Workno );
j:=j 1;
Label4.Caption:=IntToStr(j);
Label4.Refresh;
end;
end;
end;
end; Ms_ExcelAP1.ActiveWorkBook.Saved := True; // 不存檔
Ms_ExcelAP1.Application.Quit; // 離開 Ms_ExcelAP2.ActiveWorkBook.Saved := True;
Ms_ExcelAP2.Application.Quit; Ms_ExcelAP3.Worksheets[1].Activate; // 最適欄寬
Ms_ExcelAP3.Worksheets[1].Cells.Select;
Ms_ExcelAP3.Selection.Columns.AutoFit;
Ms_ExcelAP3.Caption := 'PC'; // Sheet_name Ms_ExcelAP3.Worksheets[2].activate; // 最適欄寬
Ms_ExcelAP3.Worksheets[2].Cells.Select;
Ms_ExcelAP3.Selection.Columns.AutoFit;
Ms_ExcelAP3.Caption := 'Server'; // Sheet_name Ms_ExcelAP3.Worksheets[3].activate; // 最適欄寬
Ms_ExcelAP3.Worksheets[3].Cells.Select;
Ms_ExcelAP3.Selection.Columns.AutoFit;
Ms_ExcelAP3.Caption := 'Wireless'; // Sheet_name Ms_ExcelWB3.Save;
Ms_ExcelAP3.Application.Quit; // try
// Ms_ExcelAP4.ActiveWorkBook.Saved := True; // 不存檔
// Ms_ExcelAP4.Application.Quit; // 離開
// except // end; IF Edit3.Text='1' THEN // 轉換條碼
Chang_CC_Excel_Barcode();
end; function Scan_BB_Excel( M_Workno:string ):boolean;
var
M_WorkNO_3,MM_WorkNo: string ;
M_SheetNum: integer ; // BB.EXL SHEET_NUM
M_Row : integer ; M_FCell_WorkNO : Variant ; // 搜尋工單_cell begin
M_WorkNO_3:=Copy(M_Workno,1,3);
M_SheetNum:=0;
// M_WorkNO_8:=Copy(M_Workno,8,1); // 'BWG-322P01' if M_WorkNO_3='BWG' then // 標準工單
M_SheetNum:=1;
if M_WorkNO_3='BWF' then // 包裝工單
M_SheetNum:=2;
if M_WorkNO_3='BWD' then // 重工工單
M_SheetNum:=3;
if (M_WorkNO_3='BWG') AND (COPY(M_Workno,8,1)='P') then // 試產工單
M_SheetNum:=4;
if M_SheetNum=0 then
MessageDlg('工單格式不對' M_Workno,mtWarning,[mbOK],0);// ERROR Ms_ExcelAP2.Worksheets[M_SheetNum].activate; // 選 Sheet Ms_ExcelAP2.Columns[3].Select; // 指定C 欄
M_FCell_WorkNO := Ms_ExcelAP2.cells.Find(M_Workno); // 搜尋工單 if VarIsEmpty(M_FCell_WorkNO) then // 判斷找到
begin
// ShowMessage(M_Workno ' not Found !!! '); Ms_ExcelAP3.cells[M_CC_Row,1].value:=M_Workno; // 存工單號
M_CC_Row:=M_CC_Row 1;
exit;
end; if COPY(Ms_Excelap2.cells[M_FCell_WorkNO.Row,3].value,1,10)=M_Workno then
begin
M_BB_Row:=M_FCell_WorkNO.Row;
Write_CC_Excel();
end;
end; function Write_CC_Excel():boolean; // Write to CC_Excel
var
i,j : integer ; // 調整需要 cell
M_TMP : string ;
BEGIN
J:=1;
for i:=3 to 24 do
BEGIN
M_TMP:=Ms_ExcelAP2.cells[M_BB_Row,i].value; // 標準輸出
if (i=20) or (i=21) or (i=22) or (i=23) THEN // 不要 cell
Continue; // 條碼輸出 : 不要 cell // if M_Total_Line=1 then // PC 輸出格式
// if (i=4) or (i=5) or (i=15) or (i=18) or (i=19) or (i=20) or (i=21) or (i=22) or (i=23) THEN
// Continue; // if M_Total_Line=2 then // Server 輸出格式
// if (i=4) or (i=5) or (i=8) or (i=9)or (i=10) or (i=15) or (i=20) or (i=21) or (i=22) or (i=23) THEN
// Continue; // if M_Total_Line=3 then // Wireless 輸出格式
// if (i=4) or (i=5) or (i=8) or (i=9)or (i=10) or (i=15) or (i=20) or (i=21) or (i=22) or (i=23) THEN
// Continue; IF (TRIM(M_TMP)='') then // 空白 cell
begin
j:=j 1;
Continue;
end;
Ms_ExcelAP3.cells[M_CC_Row,j].value:=M_TMP;
j:=j 1;
END;
M_CC_Row:=M_CC_Row 1;
END; procedure TForm1.Button2Click(Sender: TObject);
begin
Form2.Label1.Caption:=M_AA_File; // 顯示 原先 設定值
Form2.Label2.Caption:=M_BB_File; // form1.enabled:=False;
form2.ShowModal;
end; procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
if key ='0' then
Label6.Caption:='標準';
if key ='1' then
Label6.Caption:='條碼';
end; function Chang_CC_Excel_Barcode():boolean;
begin
end; procedure TForm1.Button3Click(Sender: TObject);
var
i,j,M_DD_Col : integer ; // 調整需要 cell
M_FCell_date : Variant ; // 搜尋 CC_Exl cell_data
begin
Ms_ExcelW3 := 'CC.xls' ; // 轉出工單資料檔
Ms_ExcelW4 := 'DD.xls' ; // 轉出條碼資料檔 Ms_ExcelW3 := Ms_Dir '\' Ms_ExcelW3 ;
Ms_ExcelW4 := Ms_Dir '\' Ms_ExcelW4 ; try
Ms_ExcelAP3 := CreateOleObject('Excel.Application');
Ms_ExcelWB3 := Ms_ExcelAP3.WorkBooks.OPEN(Ms_ExcelW3);
except
MessageDlg('Can''t Open Excel CC !!',mtWarning,[mbOK],0);
Exit;
end; try
Ms_ExcelAP4 := CreateOleObject('Excel.Application');
Ms_ExcelWB4 := Ms_ExcelAP4.WorkBooks.OPEN(Ms_ExcelW4); // 舊檔 開啟
except
Ms_ExcelWB4 := Ms_ExcelAP4.WorkBooks.add; // 新檔 重建
Ms_ExcelWB4.SaveAS(Ms_ExcelW4);
end; Label4.Caption:=IntToStr(0);
Label4.Refresh; for M_Total_Line:=1 to 3 do // 生產線
begin
Ms_ExcelAP3.Worksheets[M_Total_Line].activate;
Ms_ExcelAP4.Worksheets[M_Total_Line].activate; M_CC_Row:=1; // CC_Exl 轉出檔行數紀錄
M_DD_Row:=1; // DD_Exl 轉出檔行數紀錄
M_DD_Col:=1;
for M_CC_Row:=1 to 50 do // CC_Exl 迴路 , 一天 < 50筆工單
begin
M_FCell_date := Ms_ExcelAP3.cells[M_CC_Row,1].value; // 搜尋日期
if VarIsEmpty(M_FCell_date) then // 判斷找到
begin
// ShowMessage(M_FCell_date ' not Found !!! ');
continue;
end; // MessageDlg('當日生產工單資料 找到 !! ' mm_date,mtWarning,[mbOK],0); if M_CC_Row=1 then
begin
M_DD_Row:=1; // 存日期
Ms_ExcelAP4.cells[M_DD_Row,M_DD_Col].value:=M_FCell_date;
M_DD_Row:=M_DD_Row 1;
continue;
end; for i:=1 to 2 do // Write to DD_Exl *2 次
begin
for j:=1 to 30 do // CC_xls cell 管控
begin
if M_Total_Line=1 then // PC 輸出格式
if (j=2) or (j=3) or (j=4) or (j=8) or (j=13) or (j=14) or (j=18) THEN
Continue;
if M_Total_Line=2 then // Server 輸出格式
if (j=2) or (j=3) or (j=4) or (j=5)or (j=6) or (j=7) or (j=8) or (j=13) or (j=14) or (j=18) THEN
Continue;
if M_Total_Line=3 then // Wireless 輸出格式
if (j=2) or (j=3) or (j=4) or (j=5)or (j=6) or (j=7) or (j=8) or (j=13) or (j=14) or (j=18) THEN
Continue; M_FCell_date := Ms_ExcelAP3.cells[M_CC_Row,j].value; // cc_exl cell data
if i=1 then // 轉出文字
begin
Ms_ExcelAP4.cells[M_DD_Row,M_DD_Col].value:=M_FCell_date;
M_DD_Col:=M_DD_Col 1;
end; if (i=2) and (M_CC_Row<>1) and (M_CC_Row<>2) and (M_CC_Row<>6)then // 轉出條碼 日期.欄位名不轉
begin
if string(M_FCell_date)='' then
begin
Ms_ExcelAP4.cells[M_DD_Row,M_DD_Col].value:='';
end;
if string(M_FCell_date)<>'' then
begin
Ms_ExcelAP4.cells[M_DD_Row,M_DD_Col].value:='*' string(M_FCell_date) '*';
Ms_ExcelAP4.cells[M_DD_Row,M_DD_Col].Font.Name:='3 of 9 Barcode';
end;
M_DD_Col:=M_DD_Col 1;
end;
end;
M_DD_Row:=M_DD_Row 1;
M_DD_Col:=1;
end;
Label4.Caption:=IntToStr(StrToInt(Label4.Caption) 1);
Label4.Refresh;
end;
end; Ms_ExcelAP3.ActiveWorkBook.Saved := True; // 不存檔
Ms_ExcelAP3.Application.Quit; // 離開 Ms_ExcelAP4.Worksheets[1].Activate; // 最適欄寬
Ms_ExcelAP4.Worksheets[1].Cells.Select;
Ms_ExcelAP4.Selection.Columns.AutoFit;
Ms_ExcelAP4.Worksheets[1].Pagesetup.TopMargin := 1/0.035 ; // 列印時,上 邊距 1 cm
Ms_ExcelAP4.Worksheets[1].Pagesetup.BottomMargin := 1/0.035 ; // 列印時,下 邊距 1 cm
Ms_ExcelAP4.Worksheets[1].Pagesetup.LeftMargin := 0.5/0.035 ; // 列印時,左 邊距
Ms_ExcelAP4.Worksheets[1].Pagesetup.RightMargin := 0.5/0.035 ; // 列印時,右 邊距
Ms_ExcelAP4.Worksheets[1].Name := 'PC'; // Sheet_name
Ms_ExcelAP4.Worksheets[1].Pagesetup.Orientation := xlLandscape; // 橫印 Ms_ExcelAP4.Worksheets[1].Pagesetup.Zoom := False;
Ms_ExcelAP4.Worksheets[1].Pagesetup.FitToPagesWide := 1;
Ms_ExcelAP4.Worksheets[1].Pagesetup.FitToPagesTall := 1; Ms_ExcelAP4.Worksheets[2].activate; // 最適欄寬
Ms_ExcelAP4.Worksheets[2].Cells.Select;
Ms_ExcelAP4.Selection.Columns.AutoFit;
Ms_ExcelAP4.Worksheets[2].Pagesetup.TopMargin := 1/0.035 ; // 列印時,上 邊距 1 cm
Ms_ExcelAP4.Worksheets[2].Pagesetup.BottomMargin := 1/0.035 ; // 列印時,下 邊距 1 cm
Ms_ExcelAP4.Worksheets[2].Pagesetup.LeftMargin := 0.5/0.035 ; // 列印時,左 邊距 0.5 cm
Ms_ExcelAP4.Worksheets[2].Pagesetup.RightMargin := 0.5/0.035 ; // 列印時,右 邊距 0.5 cm
Ms_ExcelAP4.Worksheets[2].Name := 'Server'; // Sheet_name
Ms_ExcelAP4.Worksheets[2].Pagesetup.Orientation := xlLandscape; // 橫印 Ms_ExcelAP4.Worksheets[2].Pagesetup.Zoom := False;
Ms_ExcelAP4.Worksheets[2].Pagesetup.FitToPagesWide := 1;
Ms_ExcelAP4.Worksheets[2].Pagesetup.FitToPagesTall := 1; Ms_ExcelAP4.Worksheets[3].activate; // 最適欄寬
Ms_ExcelAP4.Worksheets[3].Cells.Select;
Ms_ExcelAP4.Selection.Columns.AutoFit;
Ms_ExcelAP4.Worksheets[3].Pagesetup.TopMargin := 1/0.035 ; // 列印時,上 邊距 1 cm
Ms_ExcelAP4.Worksheets[3].Pagesetup.BottomMargin := 1/0.035 ; // 列印時,下 邊距 1 cm
Ms_ExcelAP4.Worksheets[3].Pagesetup.LeftMargin := 0.5/0.035 ; // 列印時,左 邊距
Ms_ExcelAP4.Worksheets[3].Pagesetup.RightMargin := 0.5/0.035 ; // 列印時,右 邊距
Ms_ExcelAP4.Worksheets[3].Name := 'Wireless'; // Sheet_name
Ms_ExcelAP4.Worksheets[3].Pagesetup.Orientation := xlLandscape; // 橫印 Ms_ExcelAP4.Worksheets[3].Pagesetup.Zoom := False;
Ms_ExcelAP4.Worksheets[3].Pagesetup.FitToPagesWide := 1;
Ms_ExcelAP4.Worksheets[3].Pagesetup.FitToPagesTall := 1; Ms_ExcelWB4.Save;
Ms_ExcelAP4.Application.Quit; end; end. // DeleteFile(Ms_ExcelW3); // 刪除 cc.xls 一切無為法.如虛亦如空.如如心不動.萬法在其中
------
一切無為法.如虛亦如空.如如心不動.萬法在其中 |
發表時間：2004-02-12 08:50:01
IP:61.222.xxx.xxx 未訂閱
系統時間：2024-07-03 5:53:55
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |