Delphi导出Excel大全

//参数pStrCols 是需要设置为字符串格式的列

procedure TXGridLayoutCortrol.ExportData(pTitle:string='';SePTitle:String='';pTail:string='';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
strlist:=TStringList.Create();
str:='';
RzSaveDialog1.Title:='请选择需要导出到的目标文件';
if RzSaveDialog1.Execute = false then exit;
Filename:=trim(RzSaveDialog1.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;
if (rightstr(filename,4)='.htm') then begin
    strlist.Add('<div style="font-size:18pt;"><center><b>'+trim(pTitle)+'</b></center></div>'+'<tr>'+'<div style="font-size:12pt;">'+septitle+'</tr>');
    strlist.Add('<Table style="border-collapse:collapse;font-size:12pt" cellpadding=4 border=1 bordercolor=black>');

    for i:=0 to mGrid.rowcount -1 do begin
      if i=0 then strlist.Add('<tr>')
      else strlist.Add('<tr style="color:#000088">');
      for j:=0 to mGrid.ColCount - 1 do begin
        if mGrid.ColWidths[j]>0 then begin
          str := str + '<td><nobr>'+mGrid.Cells[j,i] + '</nobr></td>';
        end;
      end;
      strList.Add(str);
      strlist.Add('</tr>');
      str := '';
    end;
    strlist.Add('</Table>');
    strlist.Add('<div style="font-size:12pt">'+pTail+'</div>');
    strList.SaveToFile(Filename);
    strlist.Free;
    strlist := nil;
end
else if (rightstr(trim(filename),4)='.xls') then begin
    //导出到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 else begin
    strlist.Add(pTitle);
    for i:=0 to mGrid.rowcount -1 do begin
      for j:=0 to mGrid.ColCount - 1 do begin
        str := str + mGrid.Cells[j,i] + #9;
      end;
      strList.Add(str);
      str := '';
    end;
    strlist.Add(pTail);
    strList.SaveToFile(Filename);
    strlist.Free;
    strlist := nil;
end;
end;

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值