频道分类

DELPHI listview导出到excel

作者:admin 来源: 日期:2020/3/20 23:32:13 人气: 标签:listview

 
uses  
   ExcelXP, strutils, QDialogs, Variants;

 
 function  get_listviewTOexcel(listview:TListView;strTitle:string;strTerm :string):Boolean;
var
  //------------------------------------
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  //------------------------------------
  SaveDialog_EXCEL : TSaveDialog;//文件保存控件
  //------------------------------------
  filename :string; //文件名
  next_i   :Boolean;//是否可以继续运行
  //------------------------------------
  cyc_i    :Integer;
  cyc_j    :Integer;
  cyc_k    :Integer;
  //------------------------------------
begin
  //保存文件对话框
  SaveDialog_EXCEL := TSaveDialog.Create(nil);
  SaveDialog_EXCEL.Filter:= 'EXCEL电子表格|*.xls';
  SaveDialog_EXCEL.Title := '保存到';
  //检查Excel是否安装
  try
    ExcelApplication1 := (TExcelApplication.Create(Application));
    ExcelWorksheet1   := TExcelWorksheet.Create(Application);
    ExcelWorkbook1    := TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
    next_i := True;
  except
    Application.Messagebox('没有安装 Excel。', '错误', MB_OK + MB_ICONINFORMATION);
    Abort;
    next_i := False;
  end;
  //调用Excel----------------------
  if next_i then
    begin
      try
        ExcelApplication1.Workbooks.Add(EmptyParam, 0);
        ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
        ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
      except
        Application.Messagebox('调用Excel失败,Excel不可用。', '错误', MB_OK + MB_ICONINFORMATION);
        next_i := False;
      end;
    end;
  //选择保存到什么位置-------------
  if next_i then
    begin
      if SaveDialog_EXCEL.Execute =  True then
        begin
          if rightstr(SaveDialog_EXCEL.FileName,4) <> '.xls' then
          SaveDialog_EXCEL.FileName := SaveDialog_EXCEL.FileName + '.xls';
          filename := SaveDialog_EXCEL.FileName;
        end
      else
        begin
          next_i := False;
        end;
    end;
  //写字段名------------------------
  if next_i then
    begin
    for cyc_i:=0 to listview.Columns.Count-1 do//  DBG_WriteExcel.Columns.Count-1 do
      begin
        ExcelWorksheet1.Cells.Item[5, cyc_i + 1]:= listview.Columns[cyc_i].Caption; //DBG_WriteExcel.Columns.Items[j].Title.Caption;
        ExcelWorksheet1.Cells.item[5, cyc_i + 1].font.size := '10';
      end;
    end;
  //写数据------------------------
  if next_i then
    begin
      try
        for cyc_j := 6 to listview.Items.Count + 5 do  //行
          begin
            for cyc_i:=0 to listview.Columns.Count-1 do//列
              begin
                //列值也有可能是Caption
                if cyc_i= 0 then
                  begin
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                    //ShowMessage( listview.Columns[cyc_i].Caption +'  '+ listview.Items[cyc_j-4].Caption );
                    ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := listview.Items[cyc_j-6].Caption;
                  end
                else
                  begin
                    if listview.Columns[cyc_i].MaxWidth<>1 then
                      begin
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                        //ShowMessage( listview.Columns[cyc_i].Caption +'  '+ listview.Items[cyc_j-4].SubItems[cyc_i-1] );
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := listview.Items[cyc_j-6].SubItems[cyc_i-1];
                      end
                    else
                      begin
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].NumberFormatLocal:='@';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].font.size := '10';
                        ExcelWorksheet1.Cells.item[cyc_j, cyc_i + 1].Value  := '';
                      end
                  end;
              end;
          end;
      except
        next_i:= False;
        Application.Messagebox(pchar('网络连接失败,数据为能全部导出'), '提示',MB_OK + MB_ICONINFORMATION);
      end;
    end;
  //保存信息-----------------------
  if next_i then
    begin
      try
        ExcelWorksheet1.Columns.AutoFit;
        //表头
        with ExcelWorkSheet1 do            //将第一行的标题合并居中
          begin
            Columns.AutoFit;
            Cells.item[1, 1] := strTitle;
            Cells.Item[1, 1].font.size := '14';
            Cells.Item[1, 1].Font.Bold := True;
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].HorizontalAlignment:=xlCenter; //水平居中
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].VerticalAlignment  :=xlCenter;      //垂直居中
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].Select;
            Range[Cells.Item[1,1], Cells.Item[1,listview.Columns.Count]].Merge(Cells.Item[1,listview.Columns.Count]);     //合并单元格
          end;

//with   ExcelWorkSheet1   do            //将第一行的标题合并居中
// begin
//      Columns.AutoFit;
//      Cells.Item[1,1]:='标题';
//      Range[Cells.Item[1,1],Cells.Item[1,8]].HorizontalAlignment:=xlCenter;    //水平居中
//    Range[Cells.Item[1,1],Cells.Item[1,8]].VerticalAlignment:=xlCenter;      //垂直居中
//    Range[Cells.Item[1,1],Cells.Item[1,8]].Select;
//      Range[Cells.Item[1,1],Cells.Item[1,8]].Merge(Cells.Item[1,k]);     //合并单元格
//   Cells.Item[1,8].Font.Size:='20';
//end;

        //生成日期
        ExcelWorksheet1.Cells.item[2, 1] := '生成时间:'+ FormatDateTime('yyyy年MM月dd日  hh:mm:ss',Now);
        ExcelWorksheet1.Cells.Item[2, 1].font.size := '14';
        //查询条件
        ExcelWorksheet1.Cells.item[3, 1] := strTerm;
        ExcelWorksheet1.Cells.Item[3, 1].font.size := '14';
        //保存信息到文件
        ExcelWorksheet1.SaveAs(filename);
        Application.Messagebox(pchar('数据已成功导出至:' + UpperCase(filename) ), '提示', MB_OK + MB_ICONINFORMATION);
      except
        next_i:= False;
        Application.Messagebox(pchar('数据导出失败:' + UpperCase(filename) ), '提示', MB_OK + MB_ICONINFORMATION);
      end;
    end;

  //资源释放
  try
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  except

  end;

  Result := next_i;
end;
 
调用:  get_listviewTOexcel(ListView1,'','');

上一篇:delphi 手机号码库段号地区查询下一篇:没有资料