dbgrid导出excel

user

Comobj, office2000

procedure   SaveToExcelFile(DbgridName:TDbGrid);
  var
      XLApp:   Variant;
      Sheet:   Variant;
      WordApp,WordDoc,WordParagraph,WordRange,WordTable:variant;
      I,   J:   Integer;
      SaveDialog:TSaveDialog;
      pBookMark:   TBookMark;
      StrSaveFile:string;
      IntFileType:integer;
      SltRec,SltCol   :integer;
      ColIndex,RowIndex   :   Integer;
  begin
            if   dbgridname.DataSource.DataSet.IsEmpty   then   begin
                  messagebox(application.Handle,'没有任何数据,不能进行保存',  
                                        '警告',mb_ok);
                  abort;  
            end;  
            SaveDialog:=TSaveDialog.Create(Nil);  
            SaveDialog.Filter   :=   'Microsoft   Excel   文件|*.xls|Microsoft   Word   文件|*.doc';  
            SaveDialog.Execute;  
            IntFileType:=SaveDialog.FilterIndex;
            StrSaveFile:=SaveDialog.FileName;  
            if   length(StrSaveFile)=0   then   exit;  
            try  
                screen.Cursor:=crHourGlass;  
                case     IntFileType     of  
                      1:   begin
                                  try  
                                      XLApp:=CreateOleObject('Excel.Application');
                                      XLApp.WorkBooks.Add(-4167);
                                      XLApp.WorkBooks[1].WorkSheets[1].Name   :=   '导出数据';
                                      Sheet   :=   XLApp.WorkBooks[1].WorkSheets['导出数据'];
                                      J   :=   1;
                                  except  
                                          MessageBox(GetActiveWindow,'无法调用Mircorsoft   Excel!   '+chr(13)+chr(10)+
                                                            '请检查是否安装了Mircorsoft   Excel。','提示',MB_OK+MB_ICONINFORMATION);  
                                          Exit;  
                                  end;  
                                  with   Dbgridname.DataSource.DataSet   do
                                  begin  
                                      pBookMark   :=   GetBookmark;  
                                      DisableControls;  
                                      for   I:=0   to   dbgridname.Columns.Count-1   do  
                                      begin  
                                            if   dbgridname.Columns[I].Visible=False   then  
                                                  Continue;
                                            Sheet.Cells[J,I+1]   :=   dbgridname.Columns[I].Title.Caption;  
                                      end;
                                      Inc(J);
                                      First;  
                                      while   not   Eof   do     begin  
                                                  for   I:=0   to   dbgridname.Columns.Count-1   do   begin  
                                                          if   dbgridname.Columns[I].Visible=False   then  
                                                                Continue;
                                       
                                                          Sheet.Cells[J,I+1]   :=   trim(dbgridname.DataSource.DataSet.Fieldbyname(dbgridname.Columns[i].FieldName).asstring);  
                                    //改变颜色，字体颜色和底色  
                                  Sheet.Cells[J,I+1].font.ColorIndex   :=   3;  
                                  Sheet.Cells[J,I+1].Select;  
                                  sheet.Cells[J,I+1].Interior.ColorIndex   :=   50  
                                                  end;  
                                                  Inc(J);
                                                  Next;  
                                      end;  
                                      GotoBookmark(pBookMark);  
                                      FreeBookmark(pBookMark);  
                                      EnableControls;  
                                  end;  
                                  XLApp.activeworkbook.saveas(StrSaveFile);  
                                  Application.ProcessMessages;
                                  XLApp.Application.Quit;  
                          end;  
              2:     begin  
                      try  
                          if   VarIsEmpty(WordApp)   then  
                              WordApp   :=   CreateOleObject('word.Application');  
                              WordDoc   :=   WordApp.documents.add;  
                              WordParagraph   :=   WordApp.activedocument.paragraphs.add;
                              WordRange   :=   WordParagraph.range;  
                              WordRange.Font.Size   :=   15;  
                              WordRange.Font.Name   :=   '宋体';  
                      except  
                                MessageBox(GetActiveWindow,'无法调用Mircorsoft   Word!   '+chr(13)+chr(10)+  
                                                    '请检查是否安装了Mircorsoft   Word。','提示',MB_OK+MB_ICONINFORMATION);  
                                Abort;  
                      end;
                      SltRec:=dbgridname.SelectedRows.Count;  
                      SltCol   :=   0;  
                      for   j   :=   0   to   dbgridname.Columns.Count-1   do   begin  
                              if   dbgridname.Columns[J].Visible   then  
                                    SltCol   :=   SltCol   +1;  
                      end;  
   
                      WordRange   :=   WordApp.ActiveDocument.Content;
                      WordTable:=   WordApp.activedocument.tables.add(WordRange,SltRec   +   1,SltCol);  
                      ColIndex   :=   1;  
   
                      for   j   :=   0   to   dbgridname.Columns.Count-1     do   begin  
                              if   (dbgridname.Columns[j].Visible   =   false)   then  
                                    Continue;  
                              WordTable.Cell(1,ColIndex).Range.InsertAfter(dbgridname.Columns[j].Title.Caption);  
                              ColIndex   :=   ColIndex   +   1;
                      end;  
   
                      RowIndex   :=   2;  
                      ColIndex   :=   1;  
                      with     dbgridname.DataSource.DataSet   do   begin  
                                  First;  
                                  pBookMark   :=   GetBookmark;  
                                  DisableControls;
                                  while   not   Eof   do     begin  
                                              for   j   :=   0   to   dbgridname.Columns.Count-1   do   begin
                                                  if   (dbgridname.Columns[j].Visible<>false)   then
                                                  begin  
                                                          WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter  
                                                          (dbgridname.DataSource.DataSet.Fieldbyname(dbgridname.Columns[j].FieldName).asstring);
                                                          ColIndex   :=   ColIndex   +   1;
                                                    end;
                                              end;
                                              RowIndex   :=   RowIndex   +   1;
                                              ColIndex   :=   1;
                                              Next;
                                  end;
                                  GotoBookmark(pBookMark);
                                  FreeBookmark(pBookMark);
                                  EnableControls;
                      end;
                      WordApp.activedocument.saveas(StrSaveFile);
                      Application.ProcessMessages;
                      WordApp.Application.Quit;
                  end;
            end;
          Finally
                SaveDialog.Free;
                screen.Cursor:=crDefault;
          end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SaveToExcelFile(DbgridName);
//SaveToExcelFile.ExtractFilePath(application.ExeName) +'test.xls');
end;