StringGrid数据导出到Excel

Posted 2020-11-01 一字节

1、控件：

　　StringGrid1: TRzStringGrid;
　　ADOConnection1: TADOConnection;
　　ADOTable1: TADOTable;
　　DataSource1: TDataSource;
　　Button1: TButton;//导出数据
　　Button2: TButton;//连接数据库
　　Button3: TButton;//初始化列表

2、双击连接数据库按钮：

 1   //使用之前先关闭
 2   ADOConnection1.Close;
 3   with ADOConnection1 do
 4   begin
 5     ConnectionString :=\'Provider=SQLOLEDB.1;Password=123;Persist Security Info=True;User ID=sa;Initial Catalog=Test_DBNAME;Data Source=127.0.0.1\';
 6     try
 7       Connected := True;
 8       ShowMessage(\'数据库连接成功!\');
 9     except
10       ShowMessage(\'数据库连接失败!\');
11     end;
12     //登录时不需要在输入密码了
13     LoginPrompt := False;
14   end;
15   with ADOTable1 do
16   begin
17     //这三个顺序不能乱
18     Connection := ADOConnection1;
19     TableName := \'TableName\';
20     Active := True;
21   end;  
22   DataSource1.DataSet := ADOTable1;

3、双击初始化列表按钮：

 1   //记得在此过程前声明i，j变量哦
 2   //初始划列表
 3   ADOTable1.First;
 4   StringGrid1.RowCount := ADOTable1.RecordCount + 1;
 5   StringGrid1.ColCount := ADOTable1.FieldCount + 1;
 6   for i := 0 to ADOTable1.RecordCount - 1 do
 7   begin
 8     for j := 0 to ADOTable1.FieldCount - 1 do
 9     begin
10       StringGrid1.Cells[j + 1, 0] := ADOTable1.Fields.Fields[j].FieldName;
11       StringGrid1.Cells[0, i + 1] := IntToStr(i + 1);
12       if ADOTable1.Fields.Fields[j].Value = null then
13         StringGrid1.Cells[j + 1, i + 1] := \'\'
14       else
15         StringGrid1.Cells[j + 1, i + 1] := ADOTable1.Fields.Fields[j].Value;
16     end;
17     ADOTable1.Next;
18   end;
19   StringGrid1.FixedCols := 0;

4、新写一个导出数据的过程：

 1 //把他写成了一个过程，这样其他用到这个StringGrid的控件都可以刁永红这个来导出了
 2 procedure TForm6.ExportToExcel(RzStrGrid: TRzStringGrid);
 3 const
 4   xlNormal = -4143;
 5 var
 6   i, j, k, l: integer;
 7   filename: string;
 8   excel, Vrange: OleVariant;
 9   savedialog: tsavedialog;
10 begin
11   filename := \'\';
12   if RzStrGrid.RowCount > 65536 then
13   begin
14     if application.messagebox(\'需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？\', \'询问\', mb_yesno + mb_iconquestion) = idno then
15       exit;
16   end;
17   screen.Cursor := crHourGlass;
18 
19   try
20     excel := CreateOleObject(\'Excel.Application\');
21     excel.workbooks.add;
22   except
23     screen.cursor := crDefault;
24     showmessage(\'无法调用Excel！\');
25     exit;
26   end;
27   savedialog := tsavedialog.Create(nil);
28   savedialog.Filter := \'Excel文件(*.xls)|*.xls\';
29   if savedialog.Execute then
30   begin
31     if FileExists(savedialog.FileName) then
32     try
33       if application.messagebox(\'该文件已经存在，要覆盖吗？\', \'询问\', mb_yesno + mb_iconquestion) = idyes then
34         DeleteFile(PChar(savedialog.FileName))
35       else
36       begin
37         excel.Quit;
38         savedialog.free;
39         screen.cursor := crDefault;
40         Exit;
41       end;
42     except
43       excel.Quit;
44       savedialog.free;
45       screen.cursor := crDefault;
46       Exit;
47     end;
48     filename := savedialog.FileName;
49   end;
50   savedialog.free;
51   if filename = \'\' then
52   begin
53     excel.Quit;
54     screen.cursor := crDefault;
55     exit;
56   end;
57   //设置字体
58   excel.Cells.Font.Size := 10;
59   //导出数据到Excel
60   for i := 0 to RzStrGrid.RowCount - 1 do
61   begin
62     for j := 0 to RzStrGrid.ColCount - 1 do
63     begin
64       excel.Cells[i + 1, j + 1] := RzStrGrid.Cells[j, i];
65     end;
66   end;
67   //设置列宽
68   excel.ActiveSheet.Columns[3].ColumnWidth := 15;
69   //需要合并的单元格
70   Vrange := excel.range[excel.cells[RzStrGrid.RowCount + 1, 1], excel.cells[RzStrGrid.RowCount + 1, RzStrGrid.ColCount]];
71   Vrange.Select;
72   //合并单元格
73   Vrange.Merge(True);
74   //合并后单元格内容的字体大小
75   Vrange.Font.Size := 15;
76   Vrange.Font.Bold := True;
77   //合并单元格后的背景色
78   Vrange.Interior.ColorIndex := 6;
79   //最后一行加一个注解
80   excel.cells[RzStrGrid.RowCount + 1, 1] := \'注意：导出Excel和上一篇文章导出的Excel模板一样，可以进行导入导出\';
81   //整页的文本全都居中
82   excel.columns.HorizontalAlignment := 3;
83   try
84     //判断文件名后缀是不是.xls
85     if copy(filename, length(filename) - 3, 4) <> \'.xls\' then
86       filename := filename + \'.xls\';
87     //保存Excel
88     excel.ActiveWorkbook.SaveAs(filename, xlNormal, \'\', \'\', False, False);
89   except
90     excel.Quit;
91     screen.cursor := crDefault;
92     exit;
93   end;
94   excel.Visible := true;
95   screen.cursor := crDefault;
96 end;

双击导入数据按钮，来调用导出StringGrid数据的过程：

1 procedure TForm6.Button1Click(Sender: TObject);
2 begin
3   ExportToExcel(StringGrid1);
4 end;

好了，这样就可以了