如何操作Excel?

Question

uses
ComObj ;
var
varApp : OleVariant ;
varSheet : OleVariant ;function ExportTableToExcel( queryName : TQuery ) : Boolean ;
var
i,j : Integer ;
begin
Result:=False ;
if queryName.Active=False then
begin
ShowMessage('还未有结果数据!');
Exit ;
end;
try
varSheet:=CreateOleObject('Excel.Sheet');
except
ShowMessage('未发现安装了 Excel !');
Exit ;
end;
varApp:=varSheet.Application ;
varSheet:=varApp.ActiveSheet ;
queryName.First ;
if not queryName.eof then
begin
queryName.DisableControls ;
for i:=0 to queryName.FieldCount-1 do
begin
varSheet.Cells[1,i+1].Value:=queryName.Fields[i].FieldName ;
//修正Excel 中数字字符自动变为数字问题
if queryName.Fields[i].DataType=ftString then
begin
varSheet.Columns[i+1].NumberFormatLocal:= '@';
end;
end;
queryName.First ;
j:=2 ;
while not queryName.Eof do
begin
for i:=0 to queryName.FieldCount-1 do
begin
if not queryName.Fields[i].IsNull then
varSheet.Cells[j,i+1]:=queryName.Fields[i].DisplayText ;
end;
j:=j+1 ;
queryName.Next ;
end;
queryName.EnableControls ;
end;
varSheet.Cells.Columns.AutoFit;varApp.Visible:=true;
Result:=True ;
end;

Answer 1

如何在程序关闭EXCEL时，没有保存提示？y/n
如：在excelApplication.quit之前，如何能不提示EXCEL的保存对话框直接退出。是否保存了就不提示？但 excelApplication.workbooks.saveAs ...怎么使，无法自动进行保存。

Answer 2

unit _ExcelFunction;
                                        
interface
  uses SysUtils, ADODB, Classes, ComObj, idGlobal;  //得到一个字符串中两个指定字符或字符串中间的字符或字符串，
  //即得到字符串strOrg中两个指定字符串strItem和strSplit中间的字符串
  function getItemValue(strOrg, strItem, strSplit: string): string;  //打开一张Excel表
  function OpenExcel(theWorkBooks: OleVariant; ExcelFileName :string) : Boolean;  //打开ADO数据集
  function OpenDataSet(DataSet:TADODataSet; ASQL: string):Boolean;  //打开配置文件
  function OpenConfigFile(PosList: TStrings; ConfigFileName: string):Boolean;  //分解配置文件中的字符串，得到Col,Row,Office,FieldName的值
  function ReadInfo(strInfo: string; var Col, Row:integer; var Office : string;var FieldName:string) : Boolean;  //得到数据集DataSet的字段值
  function GetFieldValue(DataSet: TADODataSet; ValueField,SearchField,SearchValue:string):string;
  //把得到的字段值写到打开的Excel表中相应的行、列位置
  procedure WriteFieldValue(sheet: OleVariant;Col,Row:Integer;Value:string);  //执行上述过程和函数，最终把数据导到指定的Excel表中
  function MakeAExcel(ExcelFileName,LinkString,ConfigFileName,SQL:PCHAR;
     InfoList:TStrings):Boolean;  //文件拷贝implementationuses _ExcelDefine, DB, dialogs, _globeDefine;function MakeAExcel(ExcelFileName,LinkString,ConfigFileName,SQL:PCHAR;
   InfoList:TStrings):Boolean;
var
  ExcelObject, Excel, Sheet: OleVariant;
  DataSet : TADODataSet;
  PosList:TStrings;
  Col,Row,IntLoop:integer;
  Line,Office,FieldName,Value,tmpFile:string;
begin
  Result := False;
  // Create Excel Object
  if not(FileExists(string(ExcelFileName)) and FileExists(string(ConfigFileName))) then Exit;
  ExcelObject := CreateOleObject('Excel.Sheet');
  Excel := ExcelObject.Application;
  Excel.visible := False;
  DataSet := TADODataSet.Create(nil);
  DataSet.ConnectionString := LinkString;
  PosList := TStringList.Create;
  // Open Excel data
  OpenExcel(Excel.Workbooks,string(ExcelFileName));
  sheet := Excel.ActiveSheet;
  // Get the Config list.
  OpenConfigFile(PosList,string(ConfigFileName));
  // Open DataSet;
  OpenDataSet(DataSet,SQL);
  for intLoop := 0 to PosList.Count - 1 do
  begin
    Line:=PosList[IntLoop];
    ReadInfo(Line,Col,Row,Office,FieldName);
    Value:=GetFieldValue(DataSet,FieldName,itKeyFiled,''''+Office+'''');
    WriteFieldValue(Sheet,Col,Row,Value);
  end;
  for intLoop := 0 to InfoList.Count - 1 do
  begin
    Line:=InfoList[IntLoop];
    ReadInfo(Line,Col,Row,Value,Value);
    WriteFieldValue(Sheet,Col,Row,Value);
  end;
  if not DirectoryExists(csTemp) then CreateDir(csTemp);
  tmpFile := csTemp + '\'+ FormatDateTime('YYYYMMDDHHMMSS''.xls''',Now);
  Excel.ActiveWorkBook.SaveAs(tmpFile);
  Excel.Quit;
  DataSet.Free;
  PosList.Free;
  Sleep(2000);
  if FileExists(ExcelFileName) then DeleteFile(string(ExcelFileName));
  CopyFileTo(tmpFile,String(ExcelFileName));
  Sleep(2000);
  DeleteFile(tmpFile);
end;{MakeAExcel}procedure WriteFieldValue(sheet: OleVariant;Col,Row:Integer;Value:string);
begin
  Sheet.Cells(Row,Col):=Value;
end;function GetFieldValue(DataSet: TADODataSet; ValueField,SearchField,SearchValue:string):string;
begin
  Result := '';
  with DataSet do
  begin
    if (not Active)or(RecordCount < 1) then Exit;
    Filter := SearchField+'='+SearchValue;
    Filtered := true;
    if IsEmpty then Exit;
    Result := FieldByName(ValueField).AsString;
  end;
end;function getItemValue(strOrg, strItem, strSplit: string): string;
var
  intTemp:Integer;
  strTemp:string;
begin
  Result := '';
  intTemp := Pos(strItem, strOrg);
  if intTemp <= 0 then Exit;
  strTemp := '';
  intTemp := intTemp + Length(strItem);
  while intTemp <= Length(strOrg) do
  begin
    if strOrg[intTemp] = strSplit then Break;
    strTemp := strTemp + strOrg[intTemp];
    inc(intTemp);    
  end;
  Result := strTemp;
end;{getItemValue}function OpenExcel(theWorkBooks: OleVariant; ExcelFileName :string) : Boolean;
begin
  Result := False;
  if not FileExists( ExcelFileName) then Exit;
  theWorkBooks.Open(ExcelFileName);
  Result := True;
end;function ReadInfo(strInfo: string; var Col, Row:integer; var Office:string;
 var FieldName:string): Boolean;
begin
  try
    Col := strToInt(getItemValue(strInfo,itCol,itSplit));
    Row := strToInt(getItemValue(strInfo,itRow,itSplit));
    Office := getItemValue(strInfo,itOffice,itSplit);
    FieldName := getItemValue(strInfo,itFieldName,itSplit);
    Result := true;
  except
    Col := 0;
    Row := 0;
    Office := '';
    FieldName := '';
    Result := False;
  end;           
end;{ReadInfo}function OpenDataSet(DataSet:TADODataSet; ASQL: string):Boolean;
begin
  with DataSet do
  begin
    if Active then Close;
    CommandText := ASQL;
    Prepared;
    try
      Open;
      Result := True;
    except;
      Result := False;
    end;
  end;
end;function OpenConfigFile(PosList: TStrings; ConfigFileName: string):Boolean;
var
  stsTemp:TStrings;
  intLoop:integer;
  strTemp:string;
begin
  Result := False;
  if not FileExists(ConfigFileName) then Exit;
  PosList.Clear;
  stsTemp := TStringList.Create;
  stsTemp.LoadFromFile(ConfigFileName);
  for intLoop := 0 to stsTemp.Count-1 do
  begin
    strTemp := trim(stsTemp[intLoop]);
    if (strTemp = '') or (pos(itNote,strTemp)=1) then Continue;
    PosList.Add(strTemp);
  end;
  Result := True;
end;{OpenConfigFile}end.