procedure TfrmMain.xGridDataToExcel(mGrid: TStringGrid; pTitle, SePTitle, pTail, pStrCols: string); var i,j:integer; strlist:Tstringlist; str,Filename:string; h,k:integer; Excelid: OleVariant; s: string; v,sheet,range:variant; icol,irow:integer; nCols:integer; nCurrCol:integer; nCurrRow:integer; begin excelSaveto.Title:='请选择需要导出到的目标文件'; if excelSaveto.Execute = false then exit; Filename:=trim(excelSaveto.FileName); nCols := 0; for j:=0 to mGrid.ColCount - 1 do begin if mGrid.ColWidths[j]>0 then nCols := nCols + 1; end; if nCols = 0 then begin showmessage('没有数据,无法导出!'); exit; end; //导出到excel表格 try Excelid := CreateOLEObject('Excel.Application'); except Application.MessageBox('Excel没有安装!', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL); Exit; end; Excelid.Visible := false; //Excelid.Visible := true; Excelid.WorkBooks.Add; //Excelid.WorkBooks[1].WorkSheets[1].Name := pTitle; Sheet := Excelid.Workbooks[1].WorkSheets[1]; //标题 sheet.cells[1, 1] := pTitle; sheet.range[sheet.cells[1, 1],sheet.cells[1,nCols]].Select; //选择该列 Excelid.selection.HorizontalAlignment := $FFFFEFF4; //居中 Excelid.selection.MergeCells := True; //小标题 nCurrRow := 2; if SePTitle <> '' then begin Sheet.Cells[2,1] := SePTitle; sheet.range[sheet.cells[2, 1],sheet.cells[2,nCols]].Select; //选择该列 //Excelid.selection.HorizontalAlignment := $FFFFEFF4; //居中 Excelid.selection.MergeCells := True; //表体(包括表头) nCurrRow := 3; end;
for i:=0 to mGrid.RowCount-1 do begin nCurrCol := 1; for j:=0 to mGrid.ColCount-1 do begin if mGrid.ColWidths[j]>0 then begin if pos(','+inttostr(j)+',', ','+pStrCols+',')<>0 then begin //导出为字符串格式 Sheet.Cells[nCurrRow,nCurrCol].NumberFormatLocal := '@'; Sheet.Cells[nCurrRow,nCurrCol] := mGrid.Cells[j,i]; end else begin Sheet.Cells[nCurrRow,nCurrCol] := mGrid.Cells[j,i]; end; nCurrCol := nCurrCol + 1; end; end; nCurrRow := nCurrRow + 1; end; //表尾文字 Sheet.Cells[nCurrRow,1] := pTail; sheet.range[sheet.cells[nCurrRow, 1],sheet.cells[nCurrRow,nCols]].Select; //选择该列 Excelid.selection.HorizontalAlignment := $FFFFEFF4; //居中 Excelid.selection.MergeCells := True; try sheet.cells[1,1].Select; Excelid.Workbooks[1].SaveAs(FileName); Excelid.Workbooks[1].close; Excelid.Quit; except Excelid.Quit; //有时写完后立即退出,但写进程还占用着该文件,不允许退出,所以这里再退出一次 end; //实际上就是设一点点延迟, Excelid := Unassigned; end;
|
请发表评论