EXCEL控制问题 现在问题集中于 "复制粘贴" 问题本身是100分 有人能贴出比较完整操作的说明(至少比我完整吧)200分 (300分)

  • 主题发起人 主题发起人 qrenj
  • 开始时间 开始时间
Q

qrenj

Unregistered / Unconfirmed
GUEST, unregistred user!
a.拷貝整個工作表：
ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷貝指定區域：
ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.從A1位置開始粘貼：
ExcelApp.ActiveSheet.Range[ 'A1' ].PasteSpecial;
d.從文件尾部開始粘貼：
ExcelApp.ActiveSheet.Range.PasteSpecial;

上面的代码执行COPY都正常 但是执行粘贴操作时报错说参数不正确
然后看了微软的MSDN 复制粘贴了他提示的参数 一共4个参数对于(PasteSpecial来说)
仍旧报错

另外 Range.Paste 这个操作也同样出错

现在我得问题一共又两个 :
一个是Range.PasteSpecial和Paste如何实现? 请给出代码(包括具体的参数说明)
另一个是如何保存执行完的EXCEL文件 现在只有在CLOSE和QUIT的时候会提示是否要保存
以及如何取消系统在COPY后出现的"有大量信息存在于剪贴板 是否保存"这样的提示

还有一个小问题 : 以上的复制粘贴工作是否能够应用于两个不通的EXCEL文件中?

最好就是给出控制EXCEL的全部代码 看了很多地方都不是很全 :

下面是我得到的一部分:出处已经不记得了
Delphi控制Excel2000 和 从DATASET到处记录至EXCEL

希望這分資料，為論壇中的各位會員關於EXCEL操作的問題提供一些幫助。
同時也希望各位能將自己整理的、或已有的資料共享出來。
這樣可以減少大家的「重複勞動」嗎？
技術在於交流，經驗在於積累！！！！

一.使用動態創建的方法
首先創建 Excel 對象，使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject( 'Excel.Application' );

1) 顯示當前窗口：
ExcelApp.Visible := True;

2) 更改 Excel 標題欄：
ExcelApp.Caption := '應用程序調用 Microsoft Excel';

3) 添加新工作簿：
ExcelApp.WorkBooks.Add;

4) 打開已存在的工作簿：
ExcelApp.WorkBooks.Open( 'C:/Excel/Demo.xls' );

5) 設置第2個工作表為活動工作表：
ExcelApp.WorkSheets[2].Activate;
或
ExcelApp.WorksSheets[ 'Sheet2' ].Activate;

6) 給單元格賦值：
ExcelApp.Cells[1,4].Value := '第一行第四列';

7) 設置指定列的寬度（單位：字符個數），以第一列為例：
ExcelApp.ActiveSheet.Columns[1].ColumnsWidth := 5;

8) 設置指定行的高度（單位：磅）（1磅＝0.035厘米），以第二行為例：
ExcelApp.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

9) 在第8行之前插入分頁符：
ExcelApp.WorkSheets[1].Rows[8].PageBreak := 1;

10) 在第8列之前刪除分頁符：
ExcelApp.ActiveSheet.Columns[4].PageBreak := 0;

11) 指定邊框線寬度：
ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左 2-右 3-頂 4-底 5-斜( / ) 6-斜( / )

12) 清除第一行第四列單元格公式：
ExcelApp.ActiveSheet.Cells[1,4].ClearContents;

13) 設置第一行字體屬性：
ExcelApp.ActiveSheet.Rows[1].Font.Name := '隸書';
ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;

14) 進行頁面設置：

a.頁眉：
ExcelApp.ActiveSheet.PageSetup.CenterHeader := '報表演示';
b.頁腳：
ExcelApp.ActiveSheet.PageSetup.CenterFooter := '第&P頁';
c.頁眉到頂端邊距2cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.頁腳到底端邊距3cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.頂邊距2cm：
ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底邊距2cm：
ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左邊距2cm：
ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右邊距2cm：
ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.頁面水平居中：
ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.頁面垂直居中：
ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印單元格網線：
ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;

15) 拷貝操作：

a.拷貝整個工作表：
ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷貝指定區域：
ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.從A1位置開始粘貼：
ExcelApp.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.從文件尾部開始粘貼：
ExcelApp.ActiveSheet.Range.PasteSpecial;

16) 插入一行或一列：
a. ExcelApp.ActiveSheet.Rows[2].Insert;
b. ExcelApp.ActiveSheet.Columns[1].Insert;

17) 刪除一行或一列：
a. ExcelApp.ActiveSheet.Rows[2].Delete;
b. ExcelApp.ActiveSheet.Columns[1].Delete;

18) 打印預覽工作表：
ExcelApp.ActiveSheet.PrintPreview;

19) 打印輸出工作表：
ExcelApp.ActiveSheet.PrintOut;

20) 工作表保存：
if not ExcelApp.ActiveWorkBook.Saved then
ExcelApp.ActiveSheet.PrintPreview;

21) 工作表另存為：
ExcelApp.SaveAs( 'C:/Excel/Demo1.xls' );

22) 放棄存盤：
ExcelApp.ActiveWorkBook.Saved := True;

23) 關閉工作簿：
ExcelApp.WorkBooks.Close;

24) 退出 Excel：
ExcelApp.Quit;


二.使用Delphi 控件方法

在Form中分別放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。

1） 打開Excel
ExcelApplication1.Connect;

2) 顯示當前窗口：
ExcelApplication1.Visible[0]:=True;

3) 更改 Excel 標題欄：
ExcelApplication1.Caption := '應用程序調用 Microsoft Excel';

4) 添加新工作簿：
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
5) 添加新工作表：
var Temp_Worksheet: _WorkSheet;
begin
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);
End;
6) 打開已存在的工作簿：
ExcelApplication1.Workbooks.Open (c:/a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)

7) 設置第2個工作表為活動工作表：
ExcelApplication1.WorkSheets[2].Activate; 或
ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;

8) 給單元格賦值：
ExcelApplication1.Cells[1,4].Value := '第一行第四列';

9) 設置指定列的寬度（單位：字符個數），以第一列為例：
ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;

10) 設置指定行的高度（單位：磅）（1磅＝0.035厘米），以第二行為例：
ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

11) 在第8行之前插入分頁符：
ExcelApplication1.WorkSheets[1].Rows[8].PageBreak := 1;

12) 在第8列之前刪除分頁符：
ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;

13) 指定邊框線寬度：
ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左 2-右 3-頂 4-底 5-斜( / ) 6-斜( / )

14) 清除第一行第四列單元格公式：
ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;

15) 設置第一行字體屬性：
ExcelApplication1.ActiveSheet.Rows[1].Font.Name := '隸書';
ExcelApplication1.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApplication1.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True;

16) 進行頁面設置：
a.頁眉：
ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := '報表演示';
b.頁腳：
ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := '第&P頁';
c.頁眉到頂端邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.頁腳到底端邊距3cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.頂邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.頁面水平居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.頁面垂直居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印單元格網線：
ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;

17) 拷貝操作：

a.拷貝整個工作表：
ExcelApplication1.ActiveSheet.Used.Range.Copy;

b.拷貝指定區域：
ExcelApplication1.ActiveSheet.Range[ 'A1:E2' ].Copy;

c.從A1位置開始粘貼：
ExcelApplication1.ActiveSheet.Range.[ 'A1' ].PasteSpecial;

d.從文件尾部開始粘貼：
ExcelApplication1.ActiveSheet.Range.PasteSpecial;

18) 插入一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[2].Insert;
b. ExcelApplication1.ActiveSheet.Columns[1].Insert;

19) 刪除一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[2].Delete;
b. ExcelApplication1.ActiveSheet.Columns[1].Delete;

20) 打印預覽工作表：
ExcelApplication1.ActiveSheet.PrintPreview;

21) 打印輸出工作表：
ExcelApplication1.ActiveSheet.PrintOut;

22) 工作表保存：
if not ExcelApplication1.ActiveWorkBook.Saved then
ExcelApplication1.ActiveSheet.PrintPreview;

23) 工作表另存為：
ExcelApplication1.SaveAs( 'C:/Excel/Demo1.xls' );

24) 放棄存盤：
ExcelApplication1.ActiveWorkBook.Saved := True;

25) 關閉工作簿：
ExcelApplication1.WorkBooks.Close;

26) 退出 Excel：
ExcelApplication1.Quit;
ExcelApplication1.Disconnect;

三.使用Delphi控制Excle二維圖

在Form中分別放入ExcelApplication, ExcelWorkbook和ExcelWorksheet
var asheet1,achart, range:variant;

1）選擇當第一個工作薄第一個工作表
asheet1:=ExcelApplication1.Workbooks[1].Worksheets[1];

2）增加一個二維圖
achart:=asheet1.chartobjects.add(100,100,200,200);

3）選擇二維圖的形態
achart.chart.charttype:=4;

4）給二維圖賦值
series:=achart.chart.seriescollection;
range:=sheet1!r2c3:r3c9;
series.add(range,true);
5）加上二維圖的標題
achart.Chart.HasTitle:=True;
achart.Chart.ChartTitle.Characters.Text:=』 Excle二維圖』

6）




我是這樣寫的：
var i,j:integer;
ii:string;
begin

ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel Application';
try
ExcelApplication1.Workbooks.Open(ExtractFilePath(paramstr(0))+'文件名.xls',
null,null,null,null,null,null,null,null,null,null,null,null,0); //獲取當前路徑下的文件並且打開
except
ExcelApplication1.Disconnect;//出現異常情況時關閉
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);//ExcelWorkbook1與Eexcelapplication1建立連接
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);//Excelworksheet1與Excelworkbook1建立連接

fr_jjfenxi.Label3.Caption:='ExcelWorksheet1.Cells.Item[3,1]';
//ExcelApplication1.WorkBooks1.Close;
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
但是label3卻不能顯示第三行，第一列中的數據。請各位指點！！！

附說明：
一) 使用動態創建的方法

首先創建 Excel 對象，使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject( 'Excel.Application' );

1) 顯示當前窗口：
ExcelApp.Visible := True;

2) 更改 Excel 標題欄：
ExcelApp.Caption := '應用程序調用 Microsoft Excel';

3) 添加新工作簿：
ExcelApp.WorkBooks.Add;

4) 打開已存在的工作簿：
ExcelApp.WorkBooks.Open( 'C:/Excel/Demo.xls' );

5) 設置第2個工作表為活動工作表：
ExcelApp.WorkSheets[2].Activate;
或
ExcelApp.WorksSheets[ 'Sheet2' ].Activate;

6) 給單元格賦值：
ExcelApp.Cells[1,4].Value := '第一行第四列';

7) 設置指定列的寬度（單位：字符個數），以第一列為例：
ExcelApp.ActiveSheet.Columns[1].ColumnsWidth := 5;

8) 設置指定行的高度（單位：磅）（1磅＝0.035厘米），以第二行為例：
ExcelApp.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

9) 在第8行之前插入分頁符：
ExcelApp.WorkSheets[1].Rows.PageBreak := 1;

10) 在第8列之前刪除分頁符：
ExcelApp.ActiveSheet.Columns[4].PageBreak := 0;

11) 指定邊框線寬度：
ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左 2-右 3-頂 4-底 5-斜( / ) 6-斜( / )

12) 清除第一行第四列單元格公式：
ExcelApp.ActiveSheet.Cells[1,4].ClearContents;

13) 設置第一行字體屬性：
ExcelApp.ActiveSheet.Rows[1].Font.Name := '隸書';
ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;

14) 進行頁面設置：

a.頁眉：
ExcelApp.ActiveSheet.PageSetup.CenterHeader := '報表演示';
b.頁腳：
ExcelApp.ActiveSheet.PageSetup.CenterFooter := '第&P頁';
c.頁眉到頂端邊距2cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.頁腳到底端邊距3cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.頂邊距2cm：
ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底邊距2cm：
ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左邊距2cm：
ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右邊距2cm：
ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.頁面水平居中：
ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.頁面垂直居中：
ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印單元格網線：
ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;

15) 拷貝操作：

a.拷貝整個工作表：
ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷貝指定區域：
ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.從A1位置開始粘貼：
ExcelApp.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.從文件尾部開始粘貼：
ExcelApp.ActiveSheet.Range.PasteSpecial;

16) 插入一行或一列：
a. ExcelApp.ActiveSheet.Rows[2].Insert;
b. ExcelApp.ActiveSheet.Columns[1].Insert;

17) 刪除一行或一列：
a. ExcelApp.ActiveSheet.Rows[2].Delete;
b. ExcelApp.ActiveSheet.Columns[1].Delete;

18) 打印預覽工作表：
ExcelApp.ActiveSheet.PrintPreview;

19) 打印輸出工作表：
ExcelApp.ActiveSheet.PrintOut;

20) 工作表保存：
if not ExcelApp.ActiveWorkBook.Saved then
ExcelApp.ActiveSheet.PrintPreview;

21) 工作表另存為：
ExcelApp.SaveAs( 'C:/Excel/Demo1.xls' );

22) 放棄存盤：
ExcelApp.ActiveWorkBook.Saved := True;

23) 關閉工作簿：
ExcelApp.WorkBooks.Close;

24) 退出 Excel：
ExcelApp.Quit;

(二) 使用Delphi 控件方法
在Form中分別放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。

1） 打開Excel
ExcelApplication1.Connect;

2) 顯示當前窗口：
ExcelApplication1.Visible[0]:=True;

3) 更改 Excel 標題欄：
ExcelApplication1.Caption := '應用程序調用 Microsoft Excel';

4) 添加新工作簿：
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));

5) 添加新工作表：
var Temp_Worksheet: _WorkSheet;
begin
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);
End;

6) 打開已存在的工作簿：
ExcelApplication1.Workbooks.Open (c:/a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)

7) 設置第2個工作表為活動工作表：
ExcelApplication1.WorkSheets[2].Activate; 或
ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;

8) 給單元格賦值：
ExcelApplication1.Cells[1,4].Value := '第一行第四列';

9) 設置指定列的寬度（單位：字符個數），以第一列為例：
ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;

10) 設置指定行的高度（單位：磅）（1磅＝0.035厘米），以第二行為例：
ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

11) 在第8行之前插入分頁符：
ExcelApplication1.WorkSheets[1].Rows.PageBreak := 1;

12) 在第8列之前刪除分頁符：
ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;

13) 指定邊框線寬度：
ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左 2-右 3-頂 4-底 5-斜( / ) 6-斜( / )

14) 清除第一行第四列單元格公式：
ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;

15) 設置第一行字體屬性：
ExcelApplication1.ActiveSheet.Rows[1].Font.Name := '隸書';
ExcelApplication1.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApplication1.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True;

16) 進行頁面設置：
a.頁眉：
ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := '報表演示';
b.頁腳：
ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := '第&P頁';
c.頁眉到頂端邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.頁腳到底端邊距3cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.頂邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右邊距2cm：
ExcelApplication1.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.頁面水平居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.頁面垂直居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印單元格網線：
ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;

17) 拷貝操作：

a.拷貝整個工作表：
ExcelApplication1.ActiveSheet.Used.Range.Copy;

b.拷貝指定區域：
ExcelApplication1.ActiveSheet.Range[ 'A1:E2' ].Copy;

c.從A1位置開始粘貼：
ExcelApplication1.ActiveSheet.Range.[ 'A1' ].PasteSpecial;

d.從文件尾部開始粘貼：
ExcelApplication1.ActiveSheet.Range.PasteSpecial;

18) 插入一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[2].Insert;
b. ExcelApplication1.ActiveSheet.Columns[1].Insert;

19) 刪除一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[2].Delete;
b. ExcelApplication1.ActiveSheet.Columns[1].Delete;

20) 打印預覽工作表：
ExcelApplication1.ActiveSheet.PrintPreview;

21) 打印輸出工作表：
ExcelApplication1.ActiveSheet.PrintOut;

22) 工作表保存：
if not ExcelApplication1.ActiveWorkBook.Saved then
ExcelApplication1.ActiveSheet.PrintPreview;

23) 工作表另存為：
ExcelApplication1.SaveAs( 'C:/Excel/Demo1.xls' );

24) 放棄存盤：
ExcelApplication1.ActiveWorkBook.Saved := True;

25) 關閉工作簿：
ExcelApplication1.WorkBooks.Close;

26) 退出 Excel：
ExcelApplication1.Quit;
ExcelApplication1.Disconnect;

(三) 使用Delphi 控制Excle二維圖
在Form中分別放入ExcelApplication, ExcelWorkbook和ExcelWorksheet
var asheet1,achart, range:variant;


1）選擇當第一個工作薄第一個工作表
asheet1:=ExcelApplication1.Workbooks[1].Worksheets[1];

2）增加一個二維圖
achart:=asheet1.chartobjects.add(100,100,200,200);

3）選擇二維圖的形態
achart.chart.charttype:=4;

4）給二維圖賦值
series:=achart.chart.seriescollection;
range:=sheet1!r2c3:r3c9;
series.add(range,true);

5）加上二維圖的標題
achart.Chart.HasTitle:=True;
achart.Chart.ChartTitle.Characters.Text:=』 Excle二維圖』

soft.xylxw.net

////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////

这个是导出DATASET至EXCEL的代码 出处是:
http://delphi.ktop.com.tw

unit XLSFile;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;

const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;

type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);

TSetOfAtribut = set of TatributCell;

TXLSWriter = class(Tobject)
private
fstream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols,maxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor create(vFileName:string);
destructor destroy;override;
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(ds:TDataSet;fname:String);
procedure StringGridToXLS(grid:TStringGrid;fname:String);

implementation

procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
if ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].FieldName);
r:=1;
ds.first;
while (not ds.eof) and (r <= xls.maxrows) do begin
for c:=0 to ds.FieldCount-1 do
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;

// <2002-11-17> dllee
// ?穝 Dimension 莱? wirteEOF ぇ?????? if ずノ? Seek э跑 position
// if r > xls.maxrows then begin
// xls.maxrows:=r+1;
// xls.fstream.Seek(10,soFromBeginning);
// xls.WriteDimension;
// end;
// ????盢 maxrows 砞?程???τ???Α碞??Τ 65535?┮??ぃ??耞?
finally
xls.free;
end;
end;

procedure StringGridToXLS(grid:TStringGrid;fname:String);
var c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
if rMax > xls.maxrows then // ??Α程???? 65535 Rows
rMax:=xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1 do
for r:=0 to rMax-1 do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;

{ TXLSWriter }

constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
fStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
fStream:=TFileStream.Create(vFilename,fmCreate);

maxCols:=100; // <2002-11-17> dllee Column 莱赣琌ぃ???? 65535, ┮?ぃ?矪瞶
maxRows:=65535; // <2002-11-17> dllee 硂??Α程???硂或??叫猔種??戈?畐?甧?碞??硂??
end;

destructor TXLSWriter.destroy;
begin
if fStream <> nil then
fStream.free;
inherited;
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of bytes
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;

procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
begin
Writeword(3); // opcode for double
Writeword(15); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(aValue,8);
end;

procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2); // opcode for word
Writeword(9); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
Writeword(aValue);
end;

procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4); // opcode for string
slen:=length(avalue);
Writeword(slen+8); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(slen,1);
fStream.Write(aValue[1],slen);
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut) do
FAtribut:=0;

{Byte Offset Bit Description Contents
0 7 Cell is not hidden 0b
Cell is hidden 1b
6 Cell is not locked 0b
Cell is locked 1b
5-0 Reserved, must be 0 000000b
1 7-6 Font number (4 possible)
5-0 Cell format code
2 7 Cell is not shaded 0b
Cell is shaded 1b
6 Cell has no bottom border 0b
Cell has a bottom border 1b
5 Cell has no top border 0b
Cell has a top border 1b
4 Cell has no right border 0b
Cell has a right border 1b
3 Cell has no left border 0b
Cell has a left border 1b
2-0 Cell alignment code
general 000b
left 001b
center 010b
right 011b
fill 100b
Multiplan default align. 111b
}

// bit sequence 76543210

if acHidden in value then //byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;

if acLocked in value then //byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64 ;

if acShaded in value then //byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;

if acBottomBorder in value then //byte 2 bit 6
FAtribut[2] := FAtribut[2] + 64 ;

if acTopBorder in value then //byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32;

if acRightBorder in value then //byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16;

if acLeftBorder in value then //byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee 程? 3 bit 莱?Τ 1 贺匡拒
if acLeft in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then //byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then //byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;

procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w,2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr); // <2002-11-17> dllee ㄤ??篈糶??フ?﹃
end;
end;


end.
 
try
....
ExcelWorksheet1.Paste;
ExcelWorksheet1.SaveAs(filename);
ExcelApplication1.Disconnect;
finally
ExcelApplication1.Free;
ExcelWorksheet1.Free;
ExcelWorkbook1.Free;
end;
我这样试过就可以直接从内存中贴到EXCEL中，而且关闭时没有询问
 
请问楼上的:
ExcelApp.Quit;
ExcelApp.Disconnect;
ExcelApp.Free;
三者有啥区别呢? 能不能解释一下?
 
ExcelApp.Quit;//这个只是关闭呀
ExcelApp.Disconnect;//这个是不显示
ExcelApp.Free;//这个就完全释放掉了
我说的不是很清楚。不知你明不明？？
 
OK 你的50分先记下哦 呵呵 谢谢 :)

现在的问题还剩下 Range.PasteSpecial 的参数说明和实现代码 50分

以及控制EXCEL比较完整的说明 200分 应该比偶的完整的说 偶的还不是很完整呢
 
你要的是什么？我这还有些资料，你看看吧
来自：DragonPC_???, 时间：2001-12-1 22:15:00, ID：758092
这里给出一个Excel的操作单元，函概了部分常用Excel操作，不是我写的，是从Experts-Exchange
看到后收藏起来的，给大家参考。

// 该文件操作单元封装了大部分的Excel操作
// use to manipulate Excel xls File
// Dragon P.C. <2000.05.10>
unit ExcelUnit;

interface

uses
Dialogs, Messages, SysUtils, Grids, Cmp_Sec, ComObj, Ads_Misc;

{!~Add a blank WorkSheet}
Function ExcelAddWorkSheet(Excel : Variant): Boolean;

{!~Close Excel}
Function ExcelClose(Excel : Variant; SaveAll: Boolean): Boolean;

{!~Returns the Column String Value from its integer equilavent.}
Function ExcelColIntToStr(ColNum: Integer): ShortString;

{!~Returns the Column Integer Value from its Alpha equilavent.}
Function ExcelColStrToInt(ColStr: ShortString): Integer;

{!~Close All Workbooks. All workbooks can be saved or not.}
Function ExcelCloseWorkBooks(Excel : Variant; SaveAll: Boolean): Boolean;

{!~Copies a range of Excel Cells to a Delphi StringGrid. If successful
True is returned, False otherwise. If SizeStringGridToFit is True
then the StringGrid is resized to be exactly the correct dimensions to
receive the input Excel cells, otherwise the StringGrid is not resized.
If ClearStringGridFirst is true then any cells outside the input range
are cleared, otherwise existing values are retained. Please not that the
Excel cell coordinates are "1" based and the Delphi StringGrid coordinates
are zero based.}
Function ExcelCopyToStringGrid(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
StringGrid : TStringGrid;
StringGridFirstRow : Integer;
StringGridFirstCol : Integer;
{Make the StringGrid the same size as the input range}
SizeStringGridToFit : Boolean;
{cells outside input range in StringGrid are cleared}
ClearStringGridFirst : Boolean
): Boolean;

{!~Delete a WorkSheet by Name}
Function ExcelDeleteWorkSheet(
Excel : Variant;
SheetName : ShortString): Boolean;

{!~Moves the cursor to the last row and column}
Function ExcelEnd(Excel : Variant): Boolean;

{!~Finds A value and moves the cursor there.
If the value is not found then the cursor does not move.
If nothing is found then false is returned, True otherwise.}
Function ExcelFind(
Excel : Variant;
FindString : ShortString): Boolean;

{!~Finds A value in a range and moves the cursor there.
If the value is not found then the cursor does not move.
If nothing is found then false is returned, True otherwise.}
Function ExcelFindInRange(
Excel : Variant;
FindString : ShortString;
TopRow : Integer;
LeftCol : Integer;
LastRow : Integer;
LastCol : Integer): Boolean;

{!~Finds A value in a range and moves the cursor there. If the value is
not found then the cursor does not move. If nothing is found then
false is returned, True otherwise. The search directions can be defined.
If you want row searches to go from left to right then SearchRight should
be set to true, False otherwise. If you want column searches to go from
top to bottom then SearchDown should be set to true, false otherwise.
If RowsFirst is set to true then all the columns in a complete row will be
searched.}
Function ExcelFindValue(
Excel : Variant;
FindString : ShortString;
TopRow : Integer;
LeftCol : Integer;
LastRow : Integer;
LastCol : Integer;
SearchRight : Boolean;
SearchDown : Boolean;
RowsFirst : Boolean
): Boolean;

{!~Returns The First Col}
Function ExcelFirstCol(Excel : Variant): Integer;

{!~Returns The First Row}
Function ExcelFirstRow(Excel : Variant): Integer;

{!~Returns the name of the currently active worksheet
as a shortstring}
Function ExcelGetActiveSheetName(Excel : Variant): ShortString;

{!~Gets the formula in a cell.}
Function ExcelGetCellFormula(
Excel : Variant;
RowNum, ColNum: Integer): ShortString;

{!~Returns the contents of a cell as a shortstring}
Function ExcelGetCellValue(Excel : Variant; RowNum, ColNum: Integer): ShortString;

{!~Returns the the current column}
Function ExcelGetCol(Excel : Variant): Integer;

{!~Returns the the current row}
Function ExcelGetRow(Excel : Variant): Integer;

{!~Moves the cursor to the last column}
Function ExcelGoToLastCol(Excel : Variant): Boolean;

{!~Moves the cursor to the last row}
Function ExcelGoToLastRow(Excel : Variant): Boolean;

{!~Moves the cursor to the Leftmost Column}
Function ExcelGoToLeftmostCol(Excel : Variant): Boolean;

{!~Moves the cursor to the Top row}
Function ExcelGoToTopRow(Excel : Variant): Boolean;

{!~Moves the cursor to Home position, i.e., A1}
Function ExcelHome(Excel : Variant): Boolean;

{!~Returns The Last Column}
Function ExcelLastCol(Excel : Variant): Integer;

{!~Returns The Last Row}
Function ExcelLastRow(Excel : Variant): Integer;

{!~Open the file you want to work within Excel. If you want to
take advantage of optional parameters then you should use
ExcelOpenFileComplex}
Function ExcelOpenFile(Excel : Variant; FileName : String): Boolean;

{!~Open the file you want to work within Excel. If you want to
take advantage of optional parameters then you should use
ExcelOpenFileComplex}
Function ExcelOpenFileComplex(
Excel : Variant;
FileName : String;
UpdateLinks : Integer;
ReadOnly : Boolean;
Format : Integer;
Password : ShortString): Boolean;

{!~Saves the range on the currently active sheet
to to values only.}
Function ExcelPasteValuesOnly(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer): Boolean;

{!~Renames a worksheet.}
Function ExcelRenameSheet(
Excel : Variant;
OldName : ShortString;
NewName : ShortString): Boolean;

{!~Saves the range on the currently active sheet
to a DBase 4 table.}
Function ExcelSaveAsDBase4(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
OutFilePath : ShortString;
OutFileName : ShortString): Boolean;

{!~Saves the range on the currently active sheet
to a text file.}
Function ExcelSaveAsText(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
OutFilePath : ShortString;
OutFileName : ShortString): Boolean;

{!~Selects a range on the currently active sheet. From the
current cursor position a block is selected down and to the right.
The block proceeds down until an empty row is encountered. The
block proceeds right until an empty column is encountered.}
Function ExcelSelectBlock(
Excel : Variant;
FirstRow : Integer;
FirstCol : Integer): Boolean;

{!~Selects a range on the currently active sheet. From the
current cursor position a block is selected that contains
the currently active cell. The block proceeds in each
direction until an empty row or column is encountered.}
Function ExcelSelectBlockWhole(Excel: Variant): Boolean;

{!~Selects a cell on the currently active sheet}
Function ExcelSelectCell(Excel : Variant; RowNum, ColNum: Integer): Boolean;

{!~Selects a range on the currently active sheet}
Function ExcelSelectRange(
Excel : Variant;
FirstRow : Integer;
FirstCol : Integer;
LastRow : Integer;
LastCol : Integer): Boolean;

{!~Selects an Excel Sheet By Name}
Function ExcelSelectSheetByName(Excel : Variant; SheetName: String): Boolean;

{!~Sets the formula in a cell. Remember to include the equals sign "=".
If the function fails False is returned, True otherwise.}
Function ExcelSetCellFormula(
Excel : Variant;
FormulaString : ShortString;
RowNum, ColNum: Integer): Boolean;

{!~Sets the contents of a cell as a shortstring}
Function ExcelSetCellValue(
Excel : Variant;
RowNum, ColNum: Integer;
Value : ShortString): Boolean;

{!~Sets a Column Width on the currently active sheet}
Function ExcelSetColumnWidth(
Excel : Variant;
ColNum : Integer;
ColumnWidth: Integer): Boolean;

{!~Set Excel Visibility}
Function ExcelSetVisible(
Excel : Variant;
IsVisible: Boolean): Boolean;

{!~Saves the range on the currently active sheet
to values only.}
Function ExcelValuesOnly(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer): Boolean;

{!~Returns the Excel Version as a ShortString.}
Function ExcelVersion(Excel: Variant): ShortString;

Function IsBlockColSide(
Excel : Variant;
RowNum: Integer;
ColNum: Integer): Boolean; Forward;

Function IsBlockRowSide(
Excel : Variant;
RowNum: Integer;
ColNum: Integer): Boolean; Forward;


implementation


type
//Declare the constants used by Excel
SourceType = (xlConsolidation, xlDatabase, xlExternal, xlPivotTable);
Orientation = (xlHidden, xlRowField, xlColumnField, xlPageField, xlDataField);
RangeEnd = (NoValue, xlToLeft, xlToRight, xlUp, xlDown);
ExcelPasteType = (xlAllExceptBorders,xlNotes,xlFormats,xlValues,xlFormulas,xlAll);

{CAUTION!!! THESE OUTPUTS ARE ALL GARBLED! YOU SELECT xlDBF3 AND EXCEL
OUTPUTS A xlCSV.}
FileFormat = (xlAddIn, xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows, xlDBF2,
xlDBF3, xlDBF4, xlDIF, xlExcel2, xlExcel3, xlExcel4,
xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlNormal,
xlSYLK, xlTemplate, xlText, xlTextMac, xlTextMSDOS,
xlTextWindows, xlTextPrinter, xlWK1, xlWK3, xlWKS,
xlWQ1, xlWK3FM3, xlWK1FMT, xlWK1ALL);

{Add a blank WorkSheet}
Function ExcelAddWorkSheet(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Worksheets.Add;
Except
MessageDlg('Unable to add a new worksheet', mtError, [mbOK], 0);
Result := False;
End;
End;

{Sets Excel Visibility}
Function ExcelSetVisible(Excel : Variant;IsVisible: Boolean): Boolean;
Begin
Result := True;
Try
Excel.Visible := IsVisible;
Except
MessageDlg('Unable to Excel Visibility', mtError, [mbOK], 0);
Result := False;
End;
End;

{Close Excel}
Function ExcelClose(Excel : Variant; SaveAll: Boolean): Boolean;
Begin
Result := True;
Try
ExcelCloseWorkBooks(Excel, SaveAll);
Excel.Quit;
Except
MessageDlg('Unable to Close Excel', mtError, [mbOK], 0);
Result := False;
End;
End;

{Close All Workbooks. All workbooks can be saved or not.}
Function ExcelCloseWorkBooks(Excel : Variant; SaveAll: Boolean): Boolean;
var
loop: byte;
Begin
Result := True;
Try
For loop := 1 to Excel.Workbooks.Count Do
Excel.Workbooks[1].Close[SaveAll];
Except
Result := False;
End;
End;

{Selects an Excel Sheet By Name}
Function ExcelSelectSheetByName(Excel : Variant; SheetName: String): Boolean;
Begin
Result := True;
Try
Excel.Sheets[SheetName].Select;
Except
Result := False;
End;
End;

{Selects a cell on the currently active sheet}
Function ExcelSelectCell(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Begin
Result := True;
Try
Excel.ActiveSheet.Cells[RowNum, ColNum].Select;
Except
Result := False;
End;
End;

{Returns the contents of a cell as a shortstring}
Function ExcelGetCellValue(Excel : Variant; RowNum, ColNum: Integer): ShortString;
Begin
Result := '';
Try
Result := Excel.Cells[RowNum, ColNum].Value;
Except
Result := '';
End;
End;

{Returns the the current row}
Function ExcelGetRow(Excel : Variant): Integer;
Begin
Result := 1;
Try
Result := Excel.ActiveCell.Row;
Except
Result := 1;
End;
End;

{Returns the the current column}
Function ExcelGetCol(Excel : Variant): Integer;
Begin
Result := 1;
Try
Result := Excel.ActiveCell.Column;
Except
Result := 1;
End;
End;

{Moves the cursor to the last column}
Function ExcelGoToLastCol(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Selection.End[xlToRight].Select;
Except
Result := False;
End;
End;

{Moves the cursor to the last row}
Function ExcelGoToLastRow(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Selection.End[xlDown].Select;
Except
Result := False;
End;
End;

{Moves the cursor to the Top row}
Function ExcelGoToTopRow(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Selection.End[xlUp].Select;
Except
Result := False;
End;
End;

{Moves the cursor to the Leftmost Column}
Function ExcelGoToLeftmostCol(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Selection.End[xlToLeft].Select;
Except
Result := False;
End;
End;

{Moves the cursor to Home position}
Function ExcelHome(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.ActiveSheet.Cells[1,1].Select;
Except
Result := False;
End;
End;

{Moves the cursor to the last row and column}
Function ExcelEnd(Excel : Variant): Boolean;
Begin
Result := True;
Try
Excel.Selection.End[xlDown].Select;
Excel.Selection.End[xlToRight].Select;
Except
Result := False;
End;
End;

{Returns The Last Column}
Function ExcelLastCol(Excel : Variant): Integer;
Var
CurRow : Integer;
CurCol : Integer;
Begin
Result := 1;
Try
CurRow := Excel.ActiveCell.Row;
CurCol := Excel.ActiveCell.Column;
Result := CurCol;
Excel.Selection.End[xlToRight].Select;
Result := Excel.ActiveCell.Column;
Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
Except
End;
End;

{Returns The Last Row}
Function ExcelLastRow(Excel : Variant): Integer;
Var
CurRow : Integer;
CurCol : Integer;
Begin
Result := 1;
Try
CurRow := Excel.ActiveCell.Row;
CurCol := Excel.ActiveCell.Column;
Result := CurRow;
Excel.Selection.End[xlDown].Select;
Result := Excel.ActiveCell.Row;
Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
Except
End;
End;

{Returns The First Row}
Function ExcelFirstRow(Excel : Variant): Integer;
Var
CurRow : Integer;
CurCol : Integer;
Begin
Result := 1;
Try
CurRow := Excel.ActiveCell.Row;
CurCol := Excel.ActiveCell.Column;
Result := CurRow;
Excel.Selection.End[xlUp].Select;
Result := Excel.ActiveCell.Row;
Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
Except
End;
End;

{Returns The First Col}
Function ExcelFirstCol(Excel : Variant): Integer;
Var
CurRow : Integer;
CurCol : Integer;
Begin
Result := 1;
Try
CurRow := Excel.ActiveCell.Row;
CurCol := Excel.ActiveCell.Column;
Result := CurRow;
Excel.Selection.End[xlToLeft].Select;
Result := Excel.ActiveCell.Column;
Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
Except
End;
End;

{Finds A value in a range and moves the cursor there. If the value is
not found then the cursor does not move. If nothing is found then
false is returned, True otherwise.}
Function ExcelFindValue(
Excel : Variant;
FindString : ShortString;
TopRow : Integer;
LeftCol : Integer;
LastRow : Integer;
LastCol : Integer;
SearchRight : Boolean;
SearchDown : Boolean;
RowsFirst : Boolean
): Boolean;
Var
CurRow : Integer;
CurCol : Integer;
TopRowN : Integer;
LeftColN : Integer;
LastRowN : Integer;
LastColN : Integer;
ColLoop : Integer;
RowLoop : Integer;
CellValue : ShortString;
FoundRow : Integer;
FoundCol : Integer;
Found : Boolean;
Begin
Result := False;
Try
Found := False;
FindString := UpperCase(FindString);
CurRow := Excel.ActiveCell.Row;
CurCol := Excel.ActiveCell.Column;
FoundRow := CurRow;
FoundCol := CurCol;

If SearchRight Then
Begin
LeftColN := LeftCol;
LastColN := LastCol;
End
Else
Begin
LeftColN := LastCol;
LastColN := LeftCol;
End;

If SearchDown Then
Begin
TopRowN := TopRow;
LastRowN := LastRow;
End
Else
Begin
TopRowN := LastRow;
LastRowN := TopRow;
End;
If RowsFirst Then
Begin
For ColLoop := LeftColN To LastColN Do
Begin
For RowLoop := TopRowN To LastRowN Do
Begin
CellValue := ExcelGetCellValue(Excel,RowLoop, ColLoop);
If UpperCase(CellValue) = FindString Then
Begin
FoundRow := RowLoop;
FoundCol := ColLoop;
Found := True;
Break;
End;
End;
If Found Then Break;
End;
End
Else
Begin
For RowLoop := TopRowN To LastRowN Do
Begin
For ColLoop := LeftColN To LastColN Do
Begin
CellValue := ExcelGetCellValue(Excel,RowLoop, ColLoop);
If UpperCase(CellValue) = FindString Then
Begin
FoundRow := RowLoop;
FoundCol := ColLoop;
Found := True;
Break;
End;
End;
If Found Then Break;
End;
End;
Excel.Cells[FoundRow, FoundCol].Activate;
Result := Found;
Except
Result := False;
End;
End;

{Finds A value in a range and moves the cursor there. If the value is
not found then the cursor does not move. If nothing is found then
false is returned, True otherwise.}
Function ExcelFindInRange(
Excel : Variant;
FindString : ShortString;
TopRow : Integer;
LeftCol : Integer;
LastRow : Integer;
LastCol : Integer): Boolean;
Begin
Result :=
ExcelFindValue(
Excel,
FindString,
TopRow,
LeftCol,
LastRow,
LastCol,
True,
True,
True);
End;

{Finds A value and moves the cursor there. If the value is
not found then the cursor does not move. If nothing is found then
false is returned, True otherwise.}
Function ExcelFind(
Excel : Variant;
FindString : ShortString): Boolean;
Begin
Result :=
ExcelFindInRange(
Excel,
FindString,
ExcelFirstRow(Excel),
ExcelFirstCol(Excel),
ExcelLastRow(Excel),
ExcelLastCol(Excel));
End;

{!~Copies a range of Excel Cells to a Delphi StringGrid. If successful
True is returned, False otherwise. If SizeStringGridToFit is True
then the StringGrid is resized to be exactly the correct dimensions to
receive the input Excel cells, otherwise the StringGrid is not resized.
If ClearStringGridFirst is true then any cells outside the input range
are cleared, otherwise existing values are retained. Please not that the
Excel cell coordinates are "1" based and the Delphi StringGrid coordinates
are zero based.}
Function ExcelCopyToStringGrid(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
StringGrid : TStringGrid;
StringGridFirstRow : Integer;
StringGridFirstCol : Integer;
SizeStringGridToFit : Boolean; {Make the StringGrid the same size as the input range}
ClearStringGridFirst : Boolean {cells outside input range in StringGrid are cleared}
): Boolean;
Var
C,R : Integer;
Begin
Result := False;
If ExcelLastCol < ExcelFirstCol Then Exit;
If ExcelLastRow < ExcelFirstRow Then Exit;
If (ExcelFirstRow < 1) Or (ExcelFirstRow > 255) Then Exit;
If (ExcelFirstCol < 1) Or (ExcelFirstCol > 30000) Then Exit;
If (ExcelLastRow < 1) Or (ExcelLastRow > 255) Then Exit;
If (ExcelLastCol < 1) Or (ExcelLastCol > 30000) Then Exit;
If StringGrid = nil Then Exit;
If SizeStringGridToFit Then
Begin
StringGrid.ColCount := ExcelLastCol - ExcelFirstCol + StringGridFirstCol + 1;
StringGrid.RowCount := ExcelLastRow - ExcelFirstRow + StringGridFirstRow + 1;
End;
If ClearStringGridFirst Then
Begin
C := StringGrid.ColCount;
R := StringGrid.RowCount;
StringGrid.ColCount := 1;
StringGrid.RowCount := 1;
StringGrid.Cells[0,0] := '';
StringGrid.ColCount := C;
StringGrid.RowCount := R;
End;

Result := True;
For R := ExcelFirstRow To ExcelLastRow Do
Begin
For C := ExcelFirstCol To ExcelLastCol Do
Begin
Try
StringGrid.Cells[
C - ExcelFirstCol + StringGridFirstCol,
R - ExcelFirstRow + StringGridFirstRow] :=
Excel.Cells[R, C];
Except
Result := False;
End;
End;
End;
End;

{!~Sets the formula in a cell. Remember to include the equals sign "=".
If the function fails False is returned, True otherwise.}
Function ExcelSetCellFormula(
Excel : Variant;
FormulaString : ShortString;
RowNum, ColNum: Integer): Boolean;
Begin
Result := True;
Try
Excel.
ActiveSheet.
Cells[RowNum, ColNum].
Formula := FormulaString;
Except
Result := False;
End;
End;

{!~Returns the Column String Value from its integer equilavent.}
Function ExcelColIntToStr(ColNum: Integer): ShortString;
Var
ColStr : ShortString;
Multiplier: Integer;
Remainder : Integer;
Begin
Result := '';
If ColNum < 1 Then Exit;
If ColNum > 256 Then Exit;
Multiplier := ColNum div 26;
Remainder := ColNum Mod 26;
If ColNum <= 26 Then
Begin
ColStr[1] := ' ';
If Remainder = 0 Then
Begin
ColStr[2] := 'Z';
End
Else
Begin
ColStr[2] := Chr(Remainder+64);
End;
End
Else
Begin
If Remainder = 0 Then
Begin
If Multiplier = 1 Then
Begin
ColStr[1] := ' ';
ColStr[2] := 'Z';
End
Else
Begin
ColStr[1] := Chr(Multiplier+64-1);
ColStr[2] := 'Z';
End;
End
Else
Begin
ColStr[1] := Chr(Multiplier+64);
ColStr[2] := Chr(Remainder+64);
End;
End;
If ColStr[1] = ' ' Then
Begin
Result := Result + ColStr[2];
End
Else
Begin
Result := Result + ColStr[1] + ColStr[2];
End;
Result := Result;
End;

{!~Returns the Column Integer Value from its Alpha equilavent.}
Function ExcelColStrToInt(ColStr: ShortString): Integer;
Var
ColStrNew : ShortString;
i : Integer;
RetVal : Integer;
Multiplier : Integer;
Remainder : Integer;
Begin
RetVal := 1;
Result := RetVal;
ColStrNew := '';
For i := 1 To Length(ColStr) Do
Begin
If ((Ord(ColStr) >= 65) And
( Ord(ColStr) <= 90)) Or
((Ord(ColStr) >= 97) And
( Ord(ColStr) <= 122)) Then
Begin
ColStrNew := ColStrNew + UpperCase(ColStr);
End;
End;
If Length(ColStrNew) < 1 Then Exit;
If Length(ColStrNew) < 2 Then
Begin
RetVal := Ord(ColStrNew[1])-64;
End
Else
Begin
Multiplier := Ord(ColStrNew[1])-64;
Remainder := Ord(ColStrNew[2])-64;
Retval := (Multiplier * 26) + Remainder;
End;
Result := RetVal;
End;

{!~Sets the contents of a cell as a shortstring}
Function ExcelSetCellValue(
Excel : Variant;
RowNum, ColNum: Integer;
Value : ShortString): Boolean;
Begin
Result := False;
Try
Excel.Cells[RowNum, ColNum].Value := Value;
Result := True;
Except
Result := False;
End;
End;

{!~Open the file you want to work within Excel. If you want to
take advantage of optional parameters then you should use
ExcelOpenFileComplex}
Function ExcelOpenFile(Excel : Variant; FileName : String): Boolean;
Begin
Result := True;
try
//Open the database that we want to work with
Excel.Workbooks.Open[FileName];
except
MessageDlg('Unable to locate '+FileName, mtError, [mbOK], 0);
Result := False;
end;
End;

{!~Open the file you want to work within Excel.

Excel
The OLEObject passed as an argument.

FileName
Required. Specifies the filename of the workbook to open.

UpdateLinks
Specifies how links in the file are updated. If this
argument is omitted, the user is prompted to determine
how to update links. Otherwise, this argument is one of
the values shown in the following table.
Value Meaning
0 No updates
1 Updates external but not remote references
2 Updates remote but not external references
3 Updates both remote and external references

If Microsoft Excel is opening a file in the WKS, WK1, or
WK3 format and the updateLinks argument is 2, Microsoft
Excel generates charts from the graphs attached to the file.
If the argument is 0, no charts are created.

ReadOnly
If True, the workbook is opened in read-only mode.

Format
If Microsoft Excel is opening a text file, this argument
specifies the delimiter character, as shown in the following
table. If this argument is omitted, the current delimiter
is used.

Value Delimiter
1 Tabs
2 Commas
3 Spaces
4 Semicolons
5 Nothing
6 Custom character, see the delimiter argument.

Password
A string containing the password required to open a
protected workbook. If omitted and the workbook requires
a password, the user is prompted for the password.
}

Function ExcelOpenFileComplex(
Excel : Variant;
FileName : String;
UpdateLinks : Integer;
ReadOnly : Boolean;
Format : Integer;
Password : ShortString): Boolean;
Begin
Result := True;
try
//Open the database that we want to work with
Excel.
Workbooks.
Open[
FileName,
UpdateLinks,
ReadOnly,
Format,
Password];
except
MessageDlg('Unable to locate '+FileName, mtError, [mbOK], 0);
Result := False;
end;
End;

{!~Saves the range on the currently active sheet
to a DBase 4 table.}
Function ExcelSaveAsDBase4(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
OutFilePath : ShortString;
OutFileName : ShortString): Boolean;
{
OutFileFormat: Use one of the following
xlAddIn xlExcel3 xlTextMSDOS
xlCSV xlExcel4 xlTextWindows
xlCSVMac xlExcel4Workbook xlTextPrinter
xlCSVMSDOS xlIntlAddIn xlWK1
xlCSVWindows xlIntlMacro xlWK3
xlDBF2 xlNormal xlWKS
xlDBF3 xlSYLK xlWQ1
xlDBF4 xlTemplate xlWK3FM3
xlDIF xlText xlWK1FMT
xlExcel2 xlTextMac xlWK1ALL
}
Begin
Result := False;
Try
If IsTable(
OutFilePath,
OutFileName+'.dbf')
Then
Begin
If Not DBDeleteTable(
OutFilePath,
OutFileName+'.dbf')
Then
Begin
Msg('Could not delete the '+
OutFilePath+OutFileName+'.dbf'+' Table');
Msg('Process Aborted');
Exit;
End;
End;
If ExcelVersion(Excel) = '8.0' Then
Begin
ExcelSelectCell(Excel,ExcelFirstRow,ExcelFirstCol);
ExcelSelectBlockWhole(Excel);
//Excel.SendKeys('^+{END}');
End
Else
Begin
Excel.
Range(
ExcelColIntToStr(ExcelFirstCol)+
IntToStr(ExcelFirstRow)+
':'+
ExcelColIntToStr(ExcelLastCol)+
IntToStr(ExcelLastRow)
).
Select;
End;
{
FileFormat = (xlAddIn, xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows, xlDBF2,
xlDBF3, xlDBF4, xlDIF, xlExcel2, xlExcel3, xlExcel4,
xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlNormal,
xlSYLK, xlTemplate, xlText, xlTextMac, xlTextMSDOS,
xlTextWindows, xlTextPrinter, xlWK1, xlWK3, xlWKS,
xlWQ1, xlWK3FM3, xlWK1FMT, xlWK1ALL);
}
{
//CHECKING OUT THE GARBLED OUTPUT
// Produces an *.xls
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'02',xlCSV);

// Produces an *.txt
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'04',xlCSVMSDOS);

// Produces nothing
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'05',xlCSVWindows);

// Produces nothing
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'06',xlDBF2);

// Produces an *.txt
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'07',xlDBF3);

// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'08',xlDBF4);
// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'09',xlDIF);
// Produces an *.dif
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'10',xlExcel2);
// Produces an *.slk
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'11',xlExcel3);
// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'12',xlExcel4);
}
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName,xlExcel4);
Result := True;
Except
Result := False;
End;
End;

{!~Saves the range on the currently active sheet
to a text file.}
Function ExcelSaveAsText(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer;
OutFilePath : ShortString;
OutFileName : ShortString): Boolean;
{
OutFileFormat: Use one of the following
xlAddIn xlExcel3 xlTextMSDOS
xlCSV xlExcel4 xlTextWindows
xlCSVMac xlExcel4Workbook xlTextPrinter
xlCSVMSDOS xlIntlAddIn xlWK1
xlCSVWindows xlIntlMacro xlWK3
xlDBF2 xlNormal xlWKS
xlDBF3 xlSYLK xlWQ1
xlDBF4 xlTemplate xlWK3FM3
xlDIF xlText xlWK1FMT
xlExcel2 xlTextMac xlWK1ALL
}
Var
FullOutName : String;
Begin
Result := False;
Try
If OutFilePath <> '' Then
Begin
If Not (Copy(OutFilePath,Length(OutFilePath),1) = '/') Then
Begin
OutFilePath := OutFilePath + '/';
End;
End;
FullOutName := OutFilePath + OutFileName;
If FileExists(FullOutName) Then DeleteFile(FullOutName);

If ExcelVersion(Excel) = '8.0' Then
Begin
ExcelSelectCell(Excel,ExcelFirstRow,ExcelFirstCol);
ExcelSelectBlockWhole(Excel);
//Excel.SendKeys('^+{END}');
End
Else
Begin
Excel.
Range(
ExcelColIntToStr(ExcelFirstCol)+
IntToStr(ExcelFirstRow)+
':'+
ExcelColIntToStr(ExcelLastCol)+
IntToStr(ExcelLastRow)
).
Select;
End;
{
FileFormat = (xlAddIn, xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows, xlDBF2,
xlDBF3, xlDBF4, xlDIF, xlExcel2, xlExcel3, xlExcel4,
xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlNormal,
xlSYLK, xlTemplate, xlText, xlTextMac, xlTextMSDOS,
xlTextWindows, xlTextPrinter, xlWK1, xlWK3, xlWKS,
xlWQ1, xlWK3FM3, xlWK1FMT, xlWK1ALL);
}
(*
//CHECKING OUT THE GARBLED OUTPUT
// Produces an *.xls
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'02',xlCSV);
*)
// Produces an *.txt
// Excel.
// ActiveSheet.
// SaveAs(
// FullOutName,xlCSVMSDOS);
(*
// Produces nothing
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'05',xlCSVWindows);

// Produces nothing
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'06',xlDBF2);

// Produces an *.txt comma separated
Excel.
ActiveSheet.
SaveAs(
FullOutName,xlDBF3);
*)
// Produces an *.txt
Excel.
ActiveSheet.
SaveAs(
FullOutName,xlTextMSDOS);
(*
// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'08',xlDBF4);
// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'09',xlDIF);
// Produces an *.dif
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'10',xlExcel2);
// Produces an *.slk
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'11',xlExcel3);
// Produces an *.dbf
Excel.
ActiveSheet.
SaveAs(
OutFilePath+OutFileName+'12',xlExcel4);

*)
Result := True;
Except
Result := False;
End;
End;



{!~Saves the range on the currently active sheet
to to values only.}
Function ExcelPasteValuesOnly(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer): Boolean;
Var
RangeString : ShortString;
SheetName : ShortString;
SheetTemp : ShortString;
Begin
Result := True;
try
If ExcelVersion(Excel) = '8.0' Then
Begin
If Not ExcelSelectRange(
Excel,
ExcelFirstRow,
ExcelFirstCol,
ExcelLastRow,
ExcelLastCol)
Then
Begin
Result := False;
Msg('Unable to select the range to paste as values.');
Exit;
End;
Excel.Selection.Copy;
Excel.Selection.PasteSpecial(xlValues);
Excel.Application.CutCopyMode := False;
End
Else
Begin
Excel.Range(
ExcelColIntToStr(ExcelFirstCol)+IntToStr(ExcelFirstRow)+
':'+
ExcelColIntToStr(ExcelLastCol)+IntToStr(ExcelLastRow)).Select;
Excel.Selection.Copy;
Excel.Selection.PasteSpecial(xlValues);
Excel.Application.CutCopyMode := False;
Excel.Selection.Replace('#N/A','0');
End;
except
Msg('Unable to paste range as values');
Result := False;
end;
End;

{!~Sets a Column Width on the currently active sheet}
Function ExcelSetColumnWidth(Excel : Variant; ColNum, ColumnWidth: Integer): Boolean;
Var
RowWas : Integer;
ColWas : Integer;
Begin
Result := False;
Try
RowWas := ExcelGetRow(Excel);
ColWas := ExcelGetCol(Excel);
ExcelSelectCell(Excel,1,ColNum);
Excel.Selection.ColumnWidth := ColumnWidth;
ExcelSelectCell(Excel,RowWas,ColWas);
Result := True;
Except
Result := False;
End;
End;

{!~Selects a range on the currently active sheet}
Function ExcelSelectRange(
Excel : Variant;
FirstRow : Integer;
FirstCol : Integer;
LastRow : Integer;
LastCol : Integer): Boolean;
Var
r,c : Integer;
RowString : ShortString;
ColString : ShortString;
Begin
Result := False;
Try
If FirstRow < 1 Then Exit;
If FirstCol < 1 Then Exit;
If LastRow < 1 Then Exit;
If LastCol < 1 Then Exit;
If FirstCol > 255 Then Exit;
If LastCol > 255 Then Exit;

If Not ExcelSelectCell(
Excel,
FirstRow,
FirstCol)
Then
Begin
Exit;
End;
{Check for strange number combinations}
If FirstRow = LastRow Then
Begin
{Don't need to do anything}
End
Else
Begin
If FirstRow < LastRow Then
Begin
For r := FirstRow To LastRow - 1 Do
Begin
Excel.SendKeys('+{DOWN}');
End;
End
Else
Begin
For r := LastRow To FirstRow - 1 Do
Begin
Excel.SendKeys('+{UP}');
End;
End;
End;
If FirstCol = LastCol Then
Begin
{Don't need to do anything}
End
Else
Begin
If FirstCol < LastCol Then
Begin
For c := FirstCol To LastCol - 1 Do
Begin
Excel.SendKeys('+{RIGHT}');
End;
End
Else
Begin
For c := LastCol To FirstCol - 1 Do
Begin
Excel.SendKeys('+{LEFT}');
End;
End;
End;
Result := True;
Except
Result := False;
End;
End;

{!~Selects a range on the currently active sheet. From the
current cursor position a block is selected down and to the right.
The block proceeds down until an empty row is encountered. The
block proceeds right until an empty column is encountered.}
Function ExcelSelectBlock(
Excel : Variant;
FirstRow : Integer;
FirstCol : Integer): Boolean;
Begin
Result := False;
Try
ExcelSelectCell(Excel,FirstRow,FirstCol);
Excel.SendKeys('+{END}+{RIGHT}');
Excel.SendKeys('+{END}+{DOWN}');
Result := True;
Except
Result := False;
End;
End;

{!~Selects a range on the currently active sheet. From the
current cursor position a block is selected that contains
the currently active cell. The block proceeds in each
direction until an empty row or column is encountered.}
Function ExcelSelectBlockWhole(Excel: Variant): Boolean;
Var
FirstRow : Integer;
FirstCol : Integer;
LastRow : Integer;
LastCol : Integer;
RowWas : Integer;
ColWas : Integer;
Begin
Result := False;
Try
RowWas := ExcelGetRow(Excel);
ColWas := ExcelGetCol(Excel);

{If the base cell is on a side of the block, the block
will not be created properly.}

{View From Original Cell}
FirstRow := ExcelFirstRow(Excel);
FirstCol := ExcelFirstCol(Excel);
LastRow := ExcelLastRow(Excel);
LastCol := ExcelLastCol(Excel);
If (Not IsBlockColSide(Excel,RowWas,ColWas)) And
(Not IsBlockRowSide(Excel,RowWas,ColWas)) Then
Begin
{Cell is not on a side of the block}
ExcelSelectCell(Excel,FirstRow,FirstCol);
Excel.SendKeys('+{END}+{RIGHT}');
Excel.SendKeys('+{END}+{DOWN}');
Result := True;
Exit;
End;
{Row Only problem}
If (Not IsBlockColSide(Excel,RowWas,ColWas)) And
(IsBlockRowSide(Excel,RowWas,ColWas)) Then
Begin
{DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
BLOCK IS TOWARD BOTTOM RIGHT}
ExcelSelectCell(Excel,RowWas,FirstCol);
Excel.SendKeys('+{END}+{RIGHT}');
Excel.SendKeys('+{END}+{DOWN}');
Result := True;
Exit;
End;
{Column Only problem}
If (IsBlockColSide(Excel,RowWas,ColWas)) And
(Not IsBlockRowSide(Excel,RowWas,ColWas)) Then
Begin
{DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
BLOCK IS TOWARD BOTTOM RIGHT}
ExcelSelectCell(Excel,FirstRow,ColWas);
Excel.SendKeys('+{END}+{RIGHT}');
Excel.SendKeys('+{END}+{DOWN}');
Result := True;
Exit;
End;
{DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
BLOCK IS TOWARD BOTTOM RIGHT}
ExcelSelectCell(Excel,RowWas,ColWas);
Excel.SendKeys('+{END}+{RIGHT}');
Excel.SendKeys('+{END}+{DOWN}');
Result := True;
Except
Result := False;
End;
End;

Function IsBlockColSide(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Var
RowWas : Integer;
ColWas : Integer;
CellFirstSide : Integer;
CellLastSide : Integer;
FirstSideLastSide : Integer;
LastSideFirstSide : Integer;
Begin
ExcelSelectCell(Excel,RowNum,ColNum);
CellFirstSide := ExcelFirstCol(Excel);
CellLastSide := ExcelLastCol(Excel);
ExcelSelectCell(Excel,RowNum,CellFirstSide);
FirstSideLastSide := ExcelLastCol(Excel);
ExcelSelectCell(Excel,RowNum,CellLastSide);
LastSideFirstSide := ExcelFirstCol(Excel);
ExcelSelectCell(Excel,RowNum,ColNum);
If (LastSideFirstSide = ColNum) Or
(FirstSideLastSide = ColNum) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;

Function IsBlockRowSide(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Var
RowWas : Integer;
ColWas : Integer;
CellFirstSide : Integer;
CellLastSide : Integer;
FirstSideLastSide : Integer;
LastSideFirstSide : Integer;
Begin
ExcelSelectCell(Excel,RowNum,ColNum);
CellFirstSide := ExcelFirstRow(Excel);
CellLastSide := ExcelLastRow(Excel);
ExcelSelectCell(Excel,CellFirstSide,ColNum);
FirstSideLastSide := ExcelLastRow(Excel);
ExcelSelectCell(Excel,CellLastSide,ColNum);
LastSideFirstSide := ExcelFirstRow(Excel);
ExcelSelectCell(Excel,RowNum,ColNum);
If (LastSideFirstSide = RowNum) Or
(FirstSideLastSide = RowNum) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;

{!~Renames a worksheet.}
Function ExcelRenameSheet(
Excel : Variant;
OldName : ShortString;
NewName : ShortString): Boolean;
Begin
Result := False;
Try
Excel.Sheets(OldName).Name := NewName;
Result := True;
Except
Result := False;
End;
End;

{!~Delete a WorkSheet by Name}
Function ExcelDeleteWorkSheet(
Excel : Variant;
SheetName : ShortString): Boolean;
Begin
Result := False;
Try
If Not ExcelSelectSheetByName(Excel,SheetName) Then
Begin
Msg('Could not select the '+SheetName+' WorkSheet');
Exit;
End;
Excel.ActiveWindow.SelectedSheets.Delete;
Result := True;
Finally
Result := False;
End;
End;

{!~Returns the name of the currently active worksheet as a shortstring}
Function ExcelGetActiveSheetName(Excel : Variant): ShortString;
Begin
Result := '';
Try
Result := Excel.ActiveSheet.Name;
Except
Result := '';
End;
End;

{!~Saves the range on the currently active sheet to values only.}
Function ExcelValuesOnly(
Excel : Variant;
ExcelFirstRow : Integer;
ExcelFirstCol : Integer;
ExcelLastRow : Integer;
ExcelLastCol : Integer): Boolean;
Var
r,c : Integer;
s : ShortString;
Begin
Result := False;
Try
If ExcelVersion(Excel) = '8.0' Then
Begin
For r := ExcelFirstRow To ExcelLastRow Do
Begin
For c := ExcelFirstCol To ExcelLastCol Do
Begin
s := Excel.Cells[r,c].Value;
Excel.Cells[r, c].Value := s;
End;
End;
End
Else
Begin
ExcelPasteValuesOnly(
Excel,
ExcelFirstRow,
ExcelFirstCol,
ExcelLastRow,
ExcelLastCol);
End;
Result := True;;
Except
Result := False;
End;
End;

{!~Gets the formula in a cell.}
Function ExcelGetCellFormula(
Excel : Variant;
RowNum, ColNum: Integer): ShortString;
Begin
Result := ' ';
Try
Result := Excel.
ActiveSheet.
Cells[RowNum, ColNum].
Formula;
Except
Result := ' ';
End;
End;

{!~Returns the Excel Version as a ShortString.}
Function ExcelVersion(Excel: Variant): ShortString;
Var
Version : ShortString;
Begin
Result := '';
Try
Version := Excel.Version;
Result := Version;
Except
Result := '';
End;
End;

Initialization
DelphiChecker(
RunOutsideIDE_ads,
'Advanced Delphi Systems Code',
RunOutsideIDECompany_ads,
RunOutsideIDEPhone_ads,
RunOutsideIDEDate_ads);
End.
 
对了 app2001 你是使用DELPHI控件执行上面大额语句的是吧 偶直接使用Comobj调用你的语句时会出错 "automation not support" 呵呵 不过还是感谢你 分还是会给D
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

S
Delphi5 控制 Excel2000 心得(0分)
8 9 10 11 12
回复
229
查看
4K
jmlwz
J
C
转贴： 一挥间宝兰灰飞烟灭，刹那间微软如日中天。世事如朝之白露，誰与争？　李维与宝兰的故事(1分)
回复
5
查看
342
copy_paste
C
P
我等只会 选择组件-> 放在容器里头-> 调整位置和大小->调整属性-> 按两下-> 填写事件处理函数 的“程式女工”应该看看的文
回复
2
查看
453
Andersonchan
A
L
绝对精彩,李维新作(转贴)(0分)
回复
3
查看
2K
luaijun
L
C
转贴《我的回忆和一些有趣的事》--李维(0分)
回复
2
查看
5K
luyear
L
后退
顶部