DBGRID中如何把表格中的内容导出成为Excel文件 ( 积分: 50 )

Q

qet006

Unregistered / Unconfirmed
GUEST, unregistred user!
搜索了下，找到个不知道为什么老是错误：请大家看看是为什么，我加入了ComObj
一运行就错误，对了我是用D7
function CopyDbDataToExcel(Args: array of const):integer;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;

try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;

XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args.VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args.VObject).Name];

if not TDBGrid(Args.VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;

TDBGrid(Args.VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args.VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;
while not TDBGrid(Args.VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args.VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);
TDBGrid(Args.VObject).DataSource.DataSet.Next;
end;
end;

XlApp.Visible := True;
Screen.Cursor := crDefault;

end;

procedure TmainForm.Button3Click(Sender: TObject);
begin
CopyDbDataToExcel([dbgrid1]);
end;
 
搜索了下，找到个不知道为什么老是错误：请大家看看是为什么，我加入了ComObj
一运行就错误，对了我是用D7
function CopyDbDataToExcel(Args: array of const):integer;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;

try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;

XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args.VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args.VObject).Name];

if not TDBGrid(Args.VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;

TDBGrid(Args.VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args.VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;
while not TDBGrid(Args.VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args.VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);
TDBGrid(Args.VObject).DataSource.DataSet.Next;
end;
end;

XlApp.Visible := True;
Screen.Cursor := crDefault;

end;

procedure TmainForm.Button3Click(Sender: TObject);
begin
CopyDbDataToExcel([dbgrid1]);
end;
 
报什么错误啊
 
---------------------------
Debugger Exception Notification
---------------------------
Project Search.exe raised exception class EOleSysError with message '无效的类别字符串'. Process stopped. Use Step or Run to continue.
---------------------------
OK Help
---------------------------
 
你先用这个替代一下 问题慢慢找

unit DBGridExportToExcel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;


type TScrollEvents = class
BeforeScroll_Event: TDataSetNotifyEvent;
AfterScroll_Event: TDataSetNotifyEvent;
AutoCalcFields_Property: Boolean;
end;

procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);


implementation

//Support procedures: I made that in order to increase speed in
//the process of scanning large amounts
//of records in a dataset

//we make a call to the "DisableControls" procedure and then disable the "BeforeScroll" and
//"AfterScroll" events and the "AutoCalcFields" property.
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
DisableControls;
ScrollEvents := TScrollEvents.Create();
with ScrollEvents do
begin
BeforeScroll_Event := BeforeScroll;
AfterScroll_Event := AfterScroll;
AutoCalcFields_Property := AutoCalcFields;
BeforeScroll := nil;
AfterScroll := nil;
AutoCalcFields := False;
end;
end;
end;

//we make a call to the "EnableControls" procedure and then restore
// the "BeforeScroll" and "AfterScroll" events and the "AutoCalcFields" property.
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
EnableControls;
with ScrollEvents do
begin
BeforeScroll := BeforeScroll_Event;
AfterScroll := AfterScroll_Event;
AutoCalcFields := AutoCalcFields_Property;
end;
end;
end;

//This is the procedure which make the work:

procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
var
cat: _Catalog;
tbl: _Table;
col: _Column;
i: integer;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
ScrollEvents: TScrollEvents;
SavePlace: TBookmark;
begin
//
//WorkBook creation (database)
cat := CoCatalog.Create;
cat._Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');
//WorkSheet creation (table)
tbl := CoTable.Create;
tbl.Set_Name(SheetName);
//Columns creation (fields)
DBGrid.DataSource.DataSet.First;
with DBGrid.Columns do
begin
for i := 0 to Count - 1 do
if Items.Visible then
begin
col := nil;
col := CoColumn.Create;
with col do
begin
Set_Name(Items.Title.Caption);
Set_Type_(adVarWChar);
end;
//add column to table
tbl.Columns.Append(col, adVarWChar, 20);
end;
end;
//add table to database
cat.Tables.Append(tbl);

col := nil;
tbl := nil;
cat := nil;

//exporting
ADOConnection := TADOConnection.Create(nil);
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
ADOQuery.Open;


DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
try
with DBGrid.DataSource.DataSet do
begin
First;
while not Eof do
begin
ADOQuery.Append;
with DBGrid.Columns do
begin
ADOQuery.Edit;
for i := 0 to Count - 1 do
if Items.Visible then
begin
ADOQuery.FieldByName(Items.Title.Caption).AsString := FieldByName(Items.FieldName).AsString;
end;
ADOQuery.Post;
end;
Next;
end;
end;

finally
DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);

ADOQuery.Close;
ADOConnection.Close;

ADOQuery.Free;
ADOConnection.Free;

end;

end;

end.
 
给你转贴一个Excel单元
====================
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;

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;


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;

function WordOpenFileComplex(WordApp: 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 &quot;=&quot;.
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;

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;

function WordOpenFileComplex(WordApp: Variant; FileName : String;
UpdateLinks : Integer; ReadOnly : Boolean; Format : Integer;
Password : ShortString): Boolean;
Begin
Result := True;
try
WordApp.Documents.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;
ShowMessage('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
ShowMessage('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
ShowMessage('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.
 
to:Avalon
ADOX_TLB 这个单元在那呀
 
)Project->Import Type Library:
2)Select &quot;Microsoft ADO Ext. for DDL and Security&quot;
3)Uncheck &quot;Generate component wrapper&quot; at the bottom
4)Rename the class names (TTable, TColumn, TIndex, TKey, TGroup, TUser, TCatalog) in
(TXTable, TXColumn, TXIndex, TXKey, TXGroup, TXUser, TXCatalog)
in order to avoid conflicts with the already present TTable component.
5)Select the Unit dir name and press &quot;Create Unit&quot;.
It will be created a file named AOX_TLB.
Include ADOX_TLB in the &quot;uses&quot; directive inside the file in which you want
to use ADOX functionality.
 
没人可以告诉我吗
 
看看这里面的呗
http://www.delphibbs.com/keylife/iblog_show.asp?xid=4091
 
您必须登录或注册才可回复。

Similar threads

I
导出DBGrid文件到Excel
回复
0
查看
585
import
I
I
把Delphi6格式的dfm文件内容转换为Delphi5格式
回复
0
查看
611
import
I
I
Excel 4.0文件格式导出数据
回复
0
查看
752
import
I
I
如何实现ImageList中的所有Images输出到同一个bmp文件中
回复
0
查看
375
import
I
I
一个操作Excel的单元
回复
0
查看
555
import
I
顶部