怎样Delphi关联两表输出EXCEL表？

Question

怎样写两表输出EXCEL表函数？这是以前我写的输出EXCEL表函数
//输出EXCEL表
{
参数说明：
ExcelFileName : 输出文件
}
procedure TDM.CreateExcel(ExcelFileName : String; dbgeName :TDBGridEh);
var
  ExcelApp, WorkBook : Variant;
  i, j, K : Integer;
  XlsFileName : String;
  sTitle      : String;
  iSum        : Integer;
  AdoqName    : TADOQuery;
begin
  //DBGridEH的指针为空，则退出。
  if dbgeName = nil then
    Exit;  //DBGridEH的DataSource的指针为空，则退出。
  if dbgeName.DataSource = nil then
    Exit;  //DBGridEH的DataSet没有打开，则退出。
  if dbgeName.DataSource.DataSet.Active = False then
  begin
    bsSkinMessage.MessageDlg('没有打开数据表。', mtWarning, [mbOk], 0);
    Exit;
  end;  if dbgeName.DataSource.DataSet.RecordCount = 0 then
  begin
    bsSkinMessage.MessageDlg('记录为空，不能导出Excel表。', mtWarning, [mbOk], 0);
    Exit;
  end;  AdoqName := dbgeName.DataSource.DataSet as TADOQuery;  bsSkinSaveDialog.FileName := ExcelFileName + '_' + FormatDateTime('YYYYMMDDHHMMSS', Now);
  //Excel标题
  sTitle := ExcelFileName;  if bsSkinSaveDialog.Execute then
    XlsFileName := bsSkinSaveDialog.FileName
  else
  begin
    Exit;
  end;  //创建自动化对象
  try
    ExcelApp := CreateOleObject('Excel.Application');
    //打开Excel程序
    //ExcelApp.Application.Visible := True;
    WorkBook := createOleObject('Excel.Sheet');
  except
    bsSkinMessage.MessageDlg('您的操作系统中没有安装Microsoft Excel或正在使用，请安装或关闭Excel。', mtError, [mbOk], 0);
    //释放创建的组件
    Exit;
  end;  //隐藏栏目数
  k := 0;
  for i := 0 to dbgeName.Columns.Count - 1 do
    if Not(dbgeName.Columns[i].Visible) then
      k := k + 1;
  //新建一个XLS文件,并写入数据,最后关闭它
  try
    WorkBook := ExcelApp.WorkBooks.Add;
    //赋值标题
    ExcelApp.Cells(1, 1) := sTitle ;    //选择单元格
    ExcelApp.Range[ExcelMerge(dbgeName.Columns.Count - K)].select;
    //对齐方式
    ExcelApp.Selection.HorizontalAlignment := 3;
    //字体
    ExcelApp.selection.Font.Name:='宋体';
    //大小
    ExcelApp.selection.Font.Size:=16;
    //黑体
    ExcelApp.selection.Font.bold:=true;
    //行高
    ExcelApp.selection.RowHeight:=24;
    //合并单元格
    ExcelApp.range[ExcelMerge(dbgeName.Columns.Count - k)].merge;    //---------------------表头-------------------------
    k := 0;
    for i := 0 to dbgeName.Columns.Count - 1 do
      if dbgeName.Columns[i].Visible then
      begin
        //设定列格式
        ExcelApp.ActiveWorkbook.ActiveSheet.Columns[i + 1 - k].NumberFormatLocal:='@';
        ExcelApp.Cells(2, i + 1 - k) := dbgeName.Columns[i].Title.Caption;
      end
      else
        k := k + 1;    //---------------------表-------------------------
    for i := 1 to AdoqName.RecordCount do
    begin
      k := 0;
      AdoqName.recno := i;
      for j := 0 to dbgeName.Columns.Count - 1 do
        if dbgeName.Columns[j].Visible then
          ExcelApp.Cells(i + 2, j + 1 - k) := dbgeName.Columns[j].DisplayText
        else
          K := k + 1;
    end;    //---------------------合计-----------------------
    k := 0;
    iSum := AdoqName.RecordCount + 3;
    for j := 0 to dbgeName.Columns.Count - 1 do
    begin
      if dbgeName.Columns[j].Visible then
        ExcelApp.cells(iSum, j + 1 - k) := dbgeName.GetFooterValue(0, dbgeName.Columns[j])
      else
        k := k + 1;
    end;
    //保存  去掉文件名中'\\'
    XlsFileName := AnsiReplaceText(XlsFileName, '\\', '\');
    WorkBook.SaveAs(XlsFileName);    //6-mbYes
    if bsSkinMessage.MessageDlg('导出Excel表完毕，是否要打开 Microsoft Excel ？', mtConfirmation, [mbYes, mbNo], 0) = 6 then
      ExcelApp.Application.Visible := True
    else
      WorkBook.Close;
  except
    bsSkinMessage.MessageDlg('不能正确操作Excel文件，可能是该文件已被其他程序打开或系统错误。',
      mtWarning, [mbOk], 0);
    WorkBook.close;
    ExcelApp.Quit;
    //释放VARIANT变量
    ExcelApp := Unassigned;
  end;
end;
 //打开人员数据主表
  With DMBase.adoqPersonArchives, SQL do
  begin
    Close;
    Clear;
    Add('select * from tbl_PersonArchives');
    Add('where AreaId in (' + DM.QueryAreaIdChild(DM.pubAreaId) + ')');
    Add('order by EmployeeNum');
    Open;
  end;  //打开人员商场数据从表
  With DMBase.adoqEmployeeNode, SQL do
  begin
    Close;
    Clear;
    Add('select * from tbl_EmployeeNode');
    Add('where EmployeeNum=:EmployeeNum');
    Add('order by EmployeeNum, NodeNum');
    Open;
  end;

Answer 1

你可以把两表关联查询出来，
如果楼主用的是DBGridEh控件，可以用下面的代码实现直接导出EXCEL
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,SaveDialog2.FileName,True);

Answer 2

DBGridEh导出的公共过程！
Procedure GridExport(AGrid: TDBGridEh);              //列表框导出
var ExpClass:TDBGridEhExportClass;
    Ext:String;
begin
  SaveDialog1.FileName := 'file';
  if SaveDialog1.Execute then
  begin
    case SaveDialog1.FilterIndex of
      1: begin ExpClass := TDBGridEhExportAsText; Ext := 'txt'; end;
      2: begin ExpClass := TDBGridEhExportAsCSV; Ext := 'csv'; end;
      3: begin ExpClass := TDBGridEhExportAsHTML; Ext := 'htm'; end;
      4: begin ExpClass := TDBGridEhExportAsRTF; Ext := 'rtf'; end;
      5: begin ExpClass := TDBGridEhExportAsXLS; Ext := 'xls'; end;
    else
      ExpClass := nil; Ext := '';
    end;    if ExpClass <> nil then
    begin
      if UpperCase(Copy(SaveDialog1.FileName,Length(SaveDialog1.FileName)-2,3)) <>
         UpperCase(Ext) then
        SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;
      SaveDBGridEhToExportFile(ExpClass,AGrid,SaveDialog1.FileName,True)
    end;
  end;
end;

Answer 3

-------------
hqhhh(枫叶) 你挺差的。-----------
to: zglikai(likai)
此话怎讲，
能帮到你，你就看，帮不到你，你不看，
请尊重你自己的人格！