delphi7导出excel的问题

Posted 2023-04-15

代码如下
function TForm12.ToExcel(sfilename: string; ADOQuery: TADOQuery): boolean; //生成excelconst
xlNormal = -4143;
var
y: integer;
tsList: TStringList;
s, filename: string;
aSheet: Variant;
excel: OleVariant;
savedialog: tsavedialog;
begin
Result := true;
try
excel := CreateOleObject('Excel.Application');
excel.workbooks.add;
except
//screen.cursor:=crDefault;
showmessage('无法调用Excel！');
exit;
end;
savedialog := tsavedialog.Create(nil);
savedialog.FileName := sfilename; //存入文件
savedialog.Filter := 'Excel文件(*.xls)|*.xls';
if savedialog.Execute then
begin
if FileExists(savedialog.FileName) then
try
if application.messagebox('该文件已经存在，要覆盖吗？', '询问', mb_yesno + mb_iconquestion) = idyes then
DeleteFile(PChar(savedialog.FileName))
else
begin
Excel.Quit;
savedialog.free;
//screen.cursor:=crDefault;
Exit;
end;
except
Excel.Quit;
savedialog.free;
screen.cursor := crDefault;
Exit;
end;
filename := savedialog.FileName;
end;
savedialog.free;
if filename = '' then
begin
result := true;
Excel.Quit;
//screen.cursor:=crDefault;
exit;
end;
aSheet := excel.Worksheets.Item[1];
tsList := TStringList.Create;
//tsList.Add('查询结果'); //加入标题
s := ''; //加入字段名 for y := 0 to adoquery.fieldCount - 1 do
begin
s := s + adoQuery.Fields.Fields[y].FieldName + #9;
Application.ProcessMessages;
end;
tsList.Add(s);
try
try
ADOQuery.First;
while not ADOQuery.Eof do
begin
s := '';
for y := 0 to ADOQuery.FieldCount - 1 do
begin
s := s + ADOQuery.Fields[y].AsString + #9;
Application.ProcessMessages;
end;
tsList.Add(s);
ADOQuery.next; end;
Clipboard.AsText := tsList.Text;
except
result := false;
end;
finally
tsList.Free;
end;
aSheet.Paste;
MessageBox(Application.Handle, '数据导出完毕！', '系统提示', MB_ICONINFORMATION or MB_OK);
try
if copy(FileName, length(FileName) - 3, 4) <> '.xls' then
FileName := FileName + '.xls';
Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);
except
Excel.Quit;
screen.cursor := crDefault;
exit;
end;
Excel.Visible := false; //true会自动打开已经保存的excel
Excel.Quit;
Excel := UnAssigned;
end;

短点的内容还好，长点的就成这样了，怎么解决啊？！！（不要看马赛克，看下面的）

我觉得你这种用list方式导Excel，造成你导出的问题，因为里面有换行符号。我一般都用以下代码转Excel，你可以试试！

procedure TForm_main.btn_excelClick(Sender: TObject);
var
XL: Variant; //打开EXCEL文件的Variant变量
Sheet: Variant;//指向EXCEL表单的Variant变量
Range: Variant;
RecNo,I: Integer;//记录数据表的当前记录号
begin
if dlgSave1.Execute then
begin
XL := CreateOleObject('Excel.Application');
XL.Visible := true;
XL.WorkBooks.Add;
XL.WorkBooks[XL.WorkBooks.Count].WorkSheets[1].Name := 'test';
Sheet := XL.WorkBooks[XL.WorkBooks.Count].WorkSheets[Trim('test')];
RecNo := 1;

//填充表标题
for I:=0 to DBGridEh1.Columns.Count-1 do //初始化行，定位在第一 行
if DBGridEh1.Columns[I].Visible then
begin
Sheet.Cells.item[1, I+1] := DBGridEh1.Columns[I].Title.Caption; //.DisplayLabel;
Sheet.Cells[1, I+1].Borders.LineStyle:=1//加边框
end;
Sheet.rows[3].font.size:=12;

//填充数据
cds_bom.First;
while not cds_bom.Eof do
begin
for I := 0 to DBGridEh1.Columns.Count - 1 do
begin
if DBGridEh1.Columns[I].Visible then
begin
Sheet.Cells.Item[RecNo+1,I+1]:=
cds_bom.fieldbyname(DBGridEh1.Columns[I].FieldName).AsString; //［行，列］
Sheet.Cells[RecNo+1,I+1].Borders.LineStyle:=1//加边框
end;
end;

//各类标记 行着色
if cds_bom.fieldbyname('general_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_3.Font.Color;
end;

if cds_bom.fieldbyname('standard_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_4.Font.Color;
end;

if cds_bom.fieldbyname('cable_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_6.Font.Color;
end;

if cds_bom.fieldbyname('chemical_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_7.Font.Color;
end;

if cds_bom.fieldbyname('user1_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_8.Font.Color;
end;

if cds_bom.fieldbyname('user2_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_9.Font.Color;
end;

if cds_bom.fieldbyname('user3_tag').AsString='T' then
begin
Range:=XL.Range[sheet.cells[RecNo+1,1],sheet.cells[RecNo+1,DBGridEh1.Columns.Count]];
Range.Interior.Color:=checkbox_10.Font.Color;
end;

Sheet.rows[RecNo].font.size:=12;
Inc(RecNo);
cds_bom.Next;
end;

//底部颜色注释
Sheet.Cells[RecNo+3,1].Interior.Color:=checkbox_3.Font.Color;
Sheet.Cells.item[RecNo+3, 2] :=checkbox_3.Caption;
Sheet.Cells[RecNo+4,1].Interior.Color:=checkbox_4.Font.Color;
Sheet.Cells.item[RecNo+4, 2] :=checkbox_4.Caption;
Sheet.Cells[RecNo+5,1].Interior.Color:=checkbox_6.Font.Color;
Sheet.Cells.item[RecNo+5, 2] :=checkbox_6.Caption;
Sheet.Cells[RecNo+6,1].Interior.Color:=checkbox_7.Font.Color;
Sheet.Cells.item[RecNo+6, 2] :=checkbox_7.Caption;
Sheet.Cells[RecNo+7,1].Interior.Color:=checkbox_8.Font.Color;
Sheet.Cells.item[RecNo+7, 2] :=checkbox_8.Caption;
Sheet.Cells[RecNo+8,1].Interior.Color:=checkbox_9.Font.Color;
Sheet.Cells.item[RecNo+8, 2] :=checkbox_9.Caption;
Sheet.Cells[RecNo+9,1].Interior.Color:=checkbox_10.Font.Color;
Sheet.Cells.item[RecNo+9, 2] :=checkbox_10.Caption;

try
XL.WorkBooks[XL.WorkBooks.Count].SaveAs(dlgSave1.FileName);
except ;
end;
end;
end; 参考技术A 那是单元格格式的问题
你设置单元格格式为自动换行即可。 参考技术B 你可以先判断所有列中数据最长的长度是多少，然后设置excel该列的最大长度，就没有这种问题了。追问

不会，具体要改哪个地方，能给个代码吗

追答

设置某列宽度的具体方法我忘了，我也是5年前做这样的开发了。你可以上一些Delphi开发论坛找找看。

参考技术C list控件显示的数据好像不能直接导出到excel，你可以做一个查询，然后直接导出到Excel(好像是用‘另存为’）,如果你要保存在已有的Excel文档，用复制粘贴好了，也挺方便的。

没有excel从Delphi导出到excel

【中文标题】没有excel从Delphi导出到excel

【英文标题】：Exporting to excel from Delphi without having excel

【发布时间】：2011-01-30 09:17:50

【问题描述】：

我希望将数据从 Delphi 导出到 Excel，而不必拥有 Excel 副本，这可能吗？

注意CSV 不行。

【参考方案1】：

FlexCel，早期的开源现在由 TMS (http://www.tmssoftware.com/site/flexcel.asp) 管理，效果很好。

您也可以通过http://www.torry.net 查看 TmxNativeExcel。免费提供，使用原生 Biff 格式。不过我没试过。

【参考方案2】：

试试zexmlss。该库可以创建和加载 excel 2003 XML 格式文件。支持合并单元格、边框、纵横对齐等。 Zlib 许可证。使用 delphi 6、7、9-14 和 lazarus。

【讨论】：

备案：lib 已移至 GitHub 并拥有一台 fork ATM。我和 Avemey 现在都没有时间收敛这些变化。他主要专注于 FPC 和 ODS 格式，而我必须在 XE2 和 XLSX 上工作。显然我们对编码风格有不同的品味:-)

我可以推荐zexmlss - 似乎适用于 XLSX 和 ODT，可以进行格式设置、公式，而且它是免费的。我必须对代码进行小 更改才能使其在 Delphi 10 Seattle 中编译，但它正在摇摆

我试过但失败了——zip工具有问题，无法添加。

【参考方案3】：

我相信可以将 MS Office 文档创建为 HTML。您不需要在网络浏览器中打开它们或其他任何东西，文件仍然可以具有扩展名 .xls 并像正常一样在 Excel 中打开。

我刚刚创建了一个新的电子表格，并将数字 1-3 粘贴在 A 列的前三个单元格中，并将其保存为 HTML。有一堆额外的混乱可能并非都是必要的。我尽可能地删除了，这似乎是生成工作电子表格的最低要求。

尝试创建一个以此为内容的新文本文件，并将其保存为 .xls 扩展名。

<html xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns="http://www.w3.org/TR/REC-html40">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<!--[if gte mso 9]><xml>
 <x:ExcelWorkbook>
  <x:ExcelWorksheets>
   <x:ExcelWorksheet>
    <x:Name>Sheet1</x:Name>
    <x:WorksheetOptions>
     <x:Selected/>
     <x:Panes>
      <x:Pane>
       <x:Number>3</x:Number>
       <x:ActiveRow>3</x:ActiveRow>
      </x:Pane>
     </x:Panes>
     <x:ProtectContents>False</x:ProtectContents>
     <x:ProtectObjects>False</x:ProtectObjects>
     <x:ProtectScenarios>False</x:ProtectScenarios>
    </x:WorksheetOptions>
   </x:ExcelWorksheet>
  </x:ExcelWorksheets>
 </x:ExcelWorkbook>
</xml><![endif]-->
</head>
<body>

<table x:str>
    <tr>
        <td x:num width=64>1</td>
    </tr>
    <tr>
        <td x:num>2</td>
    </tr>
    <tr>
        <td x:num>3</td>
    </tr>
</table>
</body>
</html>

【讨论】：

似乎是一个很好的解决方案，谢谢马特。在 Excel 2003 中工作，但我不确定用户是否必须安装 Office 2010 的兼容性下载，才能使用您建议可用的 HTML 格式。有人用其他 Office 版本尝试过吗？

很酷，你帮我节省了数小时的图书馆搜索时间

【参考方案4】：

oExport - XLSX/ODS 原生 Delphi 导入/导出库

不需要外部 dll 库 不依赖 Excel 或 Calc 安装（无 OLE） 即使是 D7、D2007 也完全支持 Unicode 支持的单元格类型：字符串、数字、百分比、公式、时间、日期、日期时间 单元格格式：单元格宽度+高度、水平+垂直对齐、自动换行、字体、背景颜色、边框 列/行跨度 在 Delphi 2007 和 XE2 32bit+64bit 下测试和工作：应该与所有 D7 到 XE2 兼容 新的 OFiller：填写 DOCX (Word 2007)、ODT (OpenOffice Writer)、XLSX (Excel 2007)、ODS (OpenOffice Calc) 模板

http://www.kluug.at/xlsx-ods-delphi.php

根据 MPL/GPL/LGPL 三重许可获得许可 版本：MPL 1.1/GPL 2.0/LGPL 2.1

【讨论】：

请不要在很多问题中添加这个。

虽然不是（或不再）开源

OExport 无法编译 - 未找到 OWideSupport 单元！

【参考方案5】：

来自 Scalabium (scalabium.com) 的 SMExport 包括许多格式，包括安装或未安装 Excel 的 Excel 格式。

【参考方案6】：

前面提到的 NativeExcel 来自 Nika-Soft。不是免费的，但它工作正常。我现在使用它已经一年多了，没有任何问题。 http://www.nika-soft.com/nativeexcel2/

【参考方案7】：

TXLSFile 库 v.4.0。和 XLSExport 组件

我们已经成功使用了 D2007、D2009 和 D2010

什么是 TXLSFile

  TXLSFile is a Delphi library for reading and writing MS Excel 
  XLS files. It is based on direct reading and writing of files, 
  and works without OLE Automation with Microsoft Excel. 

  TXLSFile is  distributed  with  XLSExport  components  package. 
  XLSExport is a Delphi components package  for quick data 
  export  into  MS Excel file with  one line  of code.  

http://sm-software.com

【参考方案8】：

这是实现此目的的一种非常简单的方法，即使用文本文件。只需输出数据，每个字段后跟一个逗号，然后是一个回车。使用 .CSV 扩展名保存此文件。这应该仍然适用于 Excel；这些天我使用 Open Officw

【讨论】：

OP 说：“N.B. CSV 不行。”