//Dxdbgrid,则直接用SaveToexcel即可 //使用 ExcelWithOdbc 控件 function TDataModule1.GetDataToFile(DsData: TObject): Boolean; //用于将数据导入文件中 var DataSet: TCustomADODataSet; FileName: string; FileType: string; begin if not ((DsData is TCustomADODataSet) or (DsData is TDBGrid) or (DsData is TdxDBGrid)) then begin Application.MessageBox('警告:目前不支持此数据集!', '警告', MB_OK + MB_ICONERROR); exit; end;
if (DsData is TCustomADODataSet) then DataSet := DsData as TCustomADODataSet // DBGrid else if (DsData is TDBGrid) then DataSet := TDBGrid(DsData).DataSource.DataSet as TCustomADODataSet // dxDBGrid else if (DsData is TdxDBGrid) then DataSet := TdxDBGrid(DsData).DataSource.DataSet as TCustomADODataSet;
if DataSet.isEmpty then begin Application.MessageBox('警告:数据集中没有数据!', '警告', MB_OK + MB_ICONWARNING); exit; end;
if (DsData is TdxDBGrid) then begin //如果是当前所传入的参数是Dxdbgrid,则直接用SaveToexcel即可! if Application.MessageBox('如果保存为Excle文件请选择Yes,保存OpenOffice格式请选择No !', '提示', mb_yesNO + mb_defbutton1 + mb_iconinformation) = idyes then begin QCMMainFrm.GetExcelName.Options := [ofAllowMultiSelect, ofFileMustExist]; QCMMainFrm.GetExcelName.Filter := 'Excel files (*.xls)|*.XLS'; FileType := 'XLS'; end else begin QCMMainFrm.GetExcelName.Options := [ofAllowMultiSelect, ofFileMustExist]; QCMMainFrm.GetExcelName.Filter := 'Excel files (*.csv)|*.CSV'; FileType := 'CSV'; end;
if QCMMainFrm.GetExcelName.Execute then begin try FileName := QCMMainFrm.GetExcelName.FileName; if pos('.', FileName) <= 0 then FileName := FileName + '.' + FileType;
if FileExists(FileName) = true then begin if Application.MessageBox(PChar('文件' + FileName + '已经存在,是否覆盖?'), '提示', MB_YESNO + MB_ICONWARNING) = idNo then exit;
try DeleteFile(pchar(FileName)); except Application.MessageBox('请重新指定文件名!', '出现错误', MB_ICONWARNING + MB_OK); end; end;
if FileType = 'XLS' then TdxDBGrid(DsData).SaveToXLS(FileName, true) else TdxDBGrid(DsData).SaveToText(FileName, true, ',', '', ''); //保存成以逗号为分隔符号的文本文件。 Result := true; application.MessageBox('提示:数据保存成功!', '提示', mb_ok + mb_iconinformation); if (Application.MessageBox('文件保存成功,是否打开?', '提示', MB_ICONINFORMATION + MB_YESNO) = IDYES) then ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED); except Result := false; application.MessageBox('警告:数据保存失败,请重试!', '警告', mb_ok + mb_iconerror); exit; end; end; end else begin QCMMainFrm.ExcelWithOdbc.DataItems.Clear; QCMMainFrm.ExcelWithOdbc.DataItems.Add; if (DsData is TCustomADODataSet) then QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DataSet := DsData as TCustomADODataSet else if (DsData is TDBGrid) then QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DBGrid := DsData as TDBGrid else if (DsData is TdxDBGrid) then QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DxDBGrid := DsData as TdxDBGrid; Result := False; try QCMMainFrm.ExcelWithOdbc.AutoGetFileName := true; QCMMainFrm.ExcelWithOdbc.AutoOpen := true; QCMMainFrm.ExcelWithOdbc.ExcelFileName := ''; QCMMainFrm.ExcelWithOdbc.Execute(); Result := true; except Result := false; application.MessageBox('警告:数据保存失败,请重试!', '警告', mb_ok + mb_iconerror); exit; end; end; end;
//cxgrid导出数据 Uses cxExportGrid4Link; if SaveDlg.Execute then begin if SaveDlg.FileName='' then begin Application.Messagebox(Pchar('请输入文件名!'), Pchar('提示'),Mb_IconInforMation+MB_OK); exit; end;
if FileExists(SaveDlg.FileName) then begin if Application.Messagebox(Pchar('该目录下已存在这个文件,要替换吗?'), Pchar('提示'),Mb_IconInforMation+MB_YESNO)=ID_NO then Exit; DeleteFile(SaveDlg.FileName); end;
ExportGrid4ToExcel(SaveDlg.FileName, cxGrid1, True, True, false); //字符串形式
Application.Messagebox(Pchar('成功汇出数据!' + char(13) + SaveDlg.FileName), Pchar('提示'),Mb_IconInforMation+MB_OK);
end;
//StringList方法 procedure TfmMain.SaveDxGridToCSV(DxGrid: TDxDBGrid; ExcelFileName: string = ''); var i, j, SelectCount: integer; s, s1: string; theStringList: Tstringlist; FileName: string; OutFieldIndex: array of integer; Book1: Pointer; begin if not DxGrid.DataSource.DataSet.Active then Exit; if ExcelFileName <> '' then SaveDialog1.FileName := ExcelFileName; if not SaveDialog1.Execute then Exit; FileName := SaveDialog1.FileName; if trim(FileName) = '' then Exit; if (length(FileName) < 4) or (UpperCase(Copy(FileName, length(FileName) - 3, 4)) <> '.CSV') then FileName := FileName + '.csv'; DxGrid.DataSource.DataSet.DisableControls; Book1 := DxGrid.DataSource.DataSet.GetBookmark;
fmSelectFields := TfmSelectFields.Create(Self); for i := 0 to DxGrid.ColumnCount - 1 do begin if DxGrid.Columns[i].Visible then begin with fmSelectFields.ListView1.Items.Add do begin Caption := DxGrid.Columns[i].Caption; SubItems.Add(inttostr(DxGrid.Columns[i].Field.Index)); Checked := True; end; end; end; try if not (fmSelectFields.ShowModal = mrOK) then Exit; SelectCount := 0; for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do begin if fmSelectFields.ListView1.Items[i].Checked then SelectCount := SelectCount + 1; end;
s := ''; //添加字段名 if (SelectCount = 0) or (SelectCount = fmSelectFields.ListView1.Items.Count) then begin SelectCount := fmSelectFields.ListView1.Items.Count; SetLength(OutFieldIndex, SelectCount); for i := 0 to SelectCount - 1 do begin s := s + '"' + StringReplace(fmSelectFields.ListView1.Items[i].Caption, '"', '""', [rfReplaceAll]) + '",'; OutFieldIndex[i] := StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]); end; end else begin SetLength(OutFieldIndex, SelectCount); j := 0; for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do begin if fmSelectFields.ListView1.Items[i].Checked then begin s := s + '"' + StringReplace(fmSelectFields.ListView1.Items[i].Caption, '"', '""', [rfReplaceAll]) + '",'; OutFieldIndex[j] := StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]); inc(j); end; end; end; theStringList := TStringList.Create; Delete(s, length(s), 1); theStringList.Add(s); with DxGrid.DataSource.DataSet do begin First; while not Eof do begin s := ''; for i := 0 to SelectCount - 1 do begin s1 := Fields[OutFieldIndex[i]].DisplayText;//AsString; if Fields[OutFieldIndex[i]].DataType = ftString then s1 := '''' + StringReplace(s1, '"', '""', [rfReplaceAll]); s := s + '"' + (s1) + '",'; end; Next; System.Delete(s, length(s), 1); theStringList.add(s); end; end; theStringList.savetofile(FileName); theStringList.Clear; theStringList.Free; if (Application.MessageBox('文件成功保存,是否要现在打开文件?', '提示', MB_ICONQUESTION + MB_YESNO) = IDYES) then ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED); finally fmSelectFields.Free; fmSelectFields := nil; DxGrid.DataSource.DataSet.GotoBookmark(Book1); DxGrid.DataSource.DataSet.EnableControls; end; end;
//EXCEL OLE对象 procedure adoquerytoexcel(Aadoquery:TCustomADODataSet;sheetname:string=''); var XLApp: Variant; i:integer; Sheet: Variant; begin if MessageDlg('你的电脑上是否安装Excel?',mtConfirmation, [mbYes, mbNo], 0)=mrYes then begin if Aadoquery.IsEmpty then exit; // if Aadoquery.RecordCount=0 then exit; try XLApp:= CreateOleObject('Excel.Application'); XLApp.Visible := True; XLApp.Workbooks.Add(-4167); if sheetname='' then sheetname:='系统数据'; XLApp.Workbooks[1].WorkSheets[1].Name :=sheetname; Sheet := XLApp.Workbooks[1].WorkSheets[1];
for i := 1 to Aadoquery.fieldcount do begin Sheet.Cells[1, i] :=Aadoquery.fields[i-1].FieldName; end; sheet.cells[2,1].copyfromrecordset(AAdoQuery.recordset); except NewDataToExcel(Aadoquery); end; end else begin MainForm.toopenoffice(Aadoquery); end; end;
//逐条导出 procedure TfmFabricPlanning.SaveToFileClick(Sender: TObject); var FileName,Str2 :String; Str :TStringList; I :integer; begin if GetExcelName.Execute then begin FileName := GetExcelName.FileName; if uppercase(copy(FileName,length(FileName)-3,4)) <> '.CSV' then FileName := FileName + '.CSV'; Str := TStringList.Create; //HEAD Str.Add('"缸号","头缸状态","复板OK","用途","序列","交期","缸要求量","排单号","品名","要求重量","要求数量","单位","可备布量","客户","纱批","纱支布种"'); //record for I := 0 to lvwBatch.items.count - 1 do begin Str2 := '"'+ lvwBatch.Items[i].Caption + '"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[0] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[1] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[2] +'"'; Str2 := Str2+',"''' + lvwBatch.Items[i].SubItems.Strings[3] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[4] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[5] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[6] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[7] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[8] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[9] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[10] +'"'; Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[11] +'"'; Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[12],'"','""',[rfReplaceAll]) +'"'; Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[13],'"','""',[rfReplaceAll]) +'"'; Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[14],'"','""',[rfReplaceAll]) +'"';
Str.Add(Str2); end; Str.SaveToFile(FileName); if (Application.MessageBox('文件成功保存,是否要现在打开文件?', '提示', MB_ICONQUESTION + MB_YESNO) = IDYES) then ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED); end; end;
//dbgrideh导出数据 uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, RzBckgnd, ADODB, dbgridehimpexp, DBGridEh, RzLabel;
type TfrmminiExport = class(TForm) RzBackground1: TRzBackground; cmbfmt: TComboBox; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Bevel1: TBevel; SaveDialog1: TSaveDialog; labHits: TRzLabel; procedure BitBtn1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var frmminiExport: TfrmminiExport;
//导出资料使用的变量 qryExportname:string; qryExportDBGridEh:TDBGrideh; qryADOQ:tadoquery;
implementation
{$R *.dfm}
uses U_SfisPCDataModule, u_pub_func, u_qryPH;
procedure TfrmminiExport.BitBtn1Click(Sender: TObject); var expclass:tdbgridehexportclass; filename:string; begin // ShowMessage('Go...'); //ShowMessage(frmsample.cmbgd.Text); //modalResult := mrnone; if cmbfmt.Text='' then begin application.MessageBox('请选择汇出资料的格式,谢谢!','提示',mb_iconinformation+mb_ok); exit; end;
//ShowMessage('1'); if qryADOQ.Eof then begin showmessage('没有资料可以汇出,谢谢!'); exit; end;
//ShowMessage('2'); if not qryADOQ.Active then begin showmessage('数据集未开启,请先查询后再尝试汇出资料!'); exit; end;
//ShowMessage('Filefmt...');
case cmbfmt.ItemIndex of 0: begin expclass:=tdbgridehexportasxls; //ShowMessage('xls...'); filename:='.xls'; savedialog1.Filter := '*.xls|*.xls' end; 1: begin expclass:=tdbgridehexportastext; filename:='.txt'; savedialog1.Filter := '*.txt|*.txt' end; 2: begin expclass:=tdbgridehexportashtml; filename:='.html'; savedialog1.Filter := '*.html|*.html' end; 3: begin expclass:=tdbgridehexportasrtf; filename:='.rtf'; savedialog1.Filter := '*.rtf|*.rtf' end; 4: begin expclass:=tdbgridehexportascsv; filename:='.csv'; savedialog1.Filter := '*.csv|*.csv' end; else savedialog1.Filter := '*.*|*.*'; end;
if savedialog1.Execute then begin try //showmessage(sample.cmbgd.Text); //exit; //filename:=sample.cmbgd.Text + filename; //savedialog1.FileName:=filename; //savedialog1.FileName := + filename; //filename := savedialog1.FileName; //ShowMessage(savedialog1.FileName); if savedialog1.FileName = '' then begin SfisPCDataModule.systemHits('请输入文件名, 谢谢...', '提示', 0); exit; end;
FileName := savedialog1.FileName + FileName; //ShowMessage(FileName); if fileexists(FileName) then begin if application.MessageBox('文件已存在,是否覆盖 ?','提示',mb_iconinformation+mb_yesno)=idyes then deletefile(filename) else exit end;
//开始汇出资料......... savedbgridehtoexportfile(expclass, qryExportDBGridEh, filename, true); //savedbgridehtoexportfile(expclass,frmsample.DBGridEh2,'D:\111.txt',true);
application.MessageBox(PCHAR('成功汇出 ' + IntToStr(qryADOQ.RecordCount) + ' 笔资料! '),'提示',mb_iconinformation+mb_ok); except application.MessageBox('出现错误,汇出资料失败! ','提示',mb_iconinformation+mb_ok); end; end;
modalResult := mrOK;
end;
|
请发表评论