【Delphi编程】delphi-采用内存流将ListView数据导出为Excel文件（未装office可用）

最新推荐文章于 2023-12-28 13:56:02 发布

Fzuim

最新推荐文章于 2023-12-28 13:56:02 发布

阅读量2.6k

点赞数 1

分类专栏： Deiphi编程文章标签： delphi listview Excel 内存流

本文链接：https://blog.csdn.net/fzuim/article/details/51983840

版权

Deiphi编程专栏收录该内容

4 篇文章 0 订阅

订阅专栏

function TTerminalToExport.MyExportExcel(const v_List: TListView; const v_szPath: string; const v_szTitle: string): Boolean;
var
  szFileTemp, szFiled, szFile: string;
  dwRow, dwRowXls: DWORD;
  i, wFieldNums, wFileNums, wCol: WORD;
  FileList: Array[0..20] of String;
  szHander: string;//html头标签
  szEnd: string;//html尾标签
  szTR: string;//tr标签
  szEndTR: string;//tr结束标签
  szVaule: string;
  FileStream: TMemoryStream;
begin
  szFile := v_szPath;
  szFileTemp := ChangeFileExt(v_szPath, '');
  wFileNums := 1;
  FileList[wFileNums - 1] := v_szPath;

  //初始化html头标签
  szHander := '<html xmlns:x="urn:schemas-microsoft-com:office:excel"><head><!--[if gte mso 9]><xml><x:ExcelWorkbook><x:ExcelWorksheets>';
  szHander := szHander+'<x:ExcelWorksheet><x:Name>' + MakeSafeHTMLText(v_szTitle) + '</x:Name><x:WorksheetOptions><x:Print><x:ValidPrinterInfo /></x:Print></x:WorksheetOptions>';
  szHander := szHander+'</x:ExcelWorksheet></x:ExcelWorksheets></x:ExcelWorkbook></xml><![endif]--><meta http-equiv="Content-Type" content="text/html; charset=gb2312" /><style type="text/css">td {mso-number-format:''\@'';}</style></head><body><div><table><tr>';

  //初始化html尾标签
  szEnd := '</table></div></body></html>';

  //初始化tr标签
  szTR := '<tr>';
  szEndTR := '</tr>';

  wFieldNums := v_List.Columns.Count;

  try
    FileStream := TMemoryStream.Create;
    //写 html头标签
    FileStream.WriteBuffer(Pointer(szHander)^, Length(szHander));

    ///写标题
    szFiled := '<td></td><td align="center" valign="middle" height="50"><strong>' + MakeSafeHTMLText(v_szTitle) + '</strong></td></tr><tr></tr>';
    FileStream.WriteBuffer(Pointer(szFiled)^, Length(szFiled));
    FileStream.WriteBuffer(Pointer(szTR)^,Length(szTR));

    //写字段信息
    for i := 0 to wFieldNums - 1 do
    begin
      if v_List.Columns[i].Width <= 0 then Continue;
      szFiled := '<td>' + MakeSafeHTMLText(v_List.Columns[i].DisplayName) + '</td>';
      FileStream.WriteBuffer(Pointer(szFiled)^, Length(szFiled));
    end;
    FileStream.WriteBuffer(Pointer(szEndTR)^,Length(szEndTR));

    //写内容
    dwRowXls := 3;
    if v_List.Items.Count > 0 then
    begin
      for dwRow := 0 to v_List.Items.Count - 1 do
      begin
        FileStream.WriteBuffer(Pointer(szTR)^,Length(szTR));
        for wCol := 0 to wFieldNums -1 do
        begin
          if v_List.Columns[wCol].Width <= 0 then Continue;

          if wCol = 0 then szVaule := v_List.Items[dwRow].Caption
          else
            szVaule := v_List.Items[dwRow].SubItems.Strings[wCol - 1];

          FileStream.WriteBuffer(Pointer('<td>'+MakeSafeHTMLText(szVaule)+'</td>')^, Length(MakeSafeHTMLText(szVaule)) + 9);
        end;
        FileStream.WriteBuffer(Pointer(szEndTR)^, Length(szEndTR));

        //一个sheet只支持65536行
        if 0 = (dwRowXls mod 65536) then
        begin
          //写后缀
          FileStream.WriteBuffer(Pointer(szEnd)^, Length(szEnd));
          FileStream.SaveToFile(v_szPath); //保存文件
          FileStream.Size:=0;

          //写 html头标签
          FileStream.WriteBuffer(Pointer(szHander)^, Length(szHander));

          szFiled := '<td></td><td align="center" valign="middle"  height="50"><strong>' + MakeSafeHTMLText(v_szTitle) + '</strong></td></tr><tr></tr>';
          FileStream.WriteBuffer(Pointer(szFiled)^, Length(szFiled));
          FileStream.WriteBuffer(Pointer(szTR)^,Length(szTR));

          //写字段信息
          for i := 0 to wFieldNums - 1 do
          begin
            if v_List.Columns[i].Width <= 0 then Continue;
            szFiled := '<td>' + MakeSafeHTMLText(v_List.Columns[i].DisplayName) + '</td>';
            FileStream.WriteBuffer(Pointer(szFiled)^, Length(szFiled));

            dwRowXls:=2;
            Inc(wFileNums);
            szFile := szFileTemp +'(' + intTostr(wFileNums) + ').xls';
            FileList[wFileNums-1] := szFile;
          end;
        end;
        Inc(dwRowXls);
      end;
    end;
    FileStream.WriteBuffer(Pointer(szEnd)^, Length(szEnd));
    FileList[wFileNums-1] := szFile;

    //保存文件
    FileStream.SaveToFile(szFile);
    Application.MessageBox('导出记录到Excel成功！', '提示',  MB_ICONINFORMATION);
    FileStream.Free;
    Result := True;
  except
    Application.MessageBox('导出记录到Excel失败！', '提示',  MB_ICONINFORMATION);
    Result := False;
    FileStream.Free;
  end;
end;

function TTerminalToExport.MakeSafeHTMLText(TheText: widestring): string;
var
  Idx: Integer;
  Ch: wideChar;
begin
  Result := '';
  for Idx := 1 to Length(TheText) do
  begin
    Ch := TheText[Idx];
    case Ch of //html过滤规则
      '<': Result := Result + '&lt;';
      '>': Result := Result + '&gt;';
      '&': Result := Result + '&amp;';
      '"': Result := Result + '&quot;';
      '''':Result := Result +  '&#39;';
      else  
      Result := Result + Ch;
       end;
    end;

end;

function TTerminalToExport.GetExcelSheetName(const v_szTitle: String): String;
const
  byReplace = '_'; //替换特殊字符
var
  szName: string;
begin
  szName := v_szTitle;
  if szName = '' then szName := byReplace  //工作簿名称不能为空
  else
  begin
    //工作簿名称不能包含以下字符 : / ? * [ ]
    szName:=StringReplace(szName, ':', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '∶', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '\', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '＼', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '/', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '／', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '?', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '？', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '*', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '＊', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '[', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '［', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, ']', byReplace, [rfReplaceAll]);
    szName:=StringReplace(szName, '］', byReplace, [rfReplaceAll]);

    if Length(WideString(szName)) > miSheetMaxLen then //工作簿名称长度不能超过31
      szName := Copy(WideString(szName),1,miSheetMaxLen);
  end;
  Result := szName;
end;

Fzuim

关注

1
点赞
踩
4

收藏

觉得还不错? 一键收藏
5
评论
【Delphi编程】delphi-采用内存流将ListView数据导出为Excel文件（未装office可用）

function TTerminalToExport.MyExportExcel(const v_List: TListView; const v_szPath: string; const v_szTitle: string): Boolean;var szFileTemp, szFiled, szFile: string; dwRow, dwRowXls: DWORD; i, ...
复制链接

扫一扫