Buscar por:
Exportando dados para o excel

Código
Em Uses, digite: Excel97, Excel2000 referente aos arquivos excel97.dcu e excel2000.dcu em: C:Arquivos de programasBorlandDelphi5Imports

Declare a Funcion depois de : {$R *.DFM}

function TFmMain.ExpGrid(Classe: TClass; DBGrid :TDbGrid; OPCAO :Integer; NomeArquivo :string):String;

var

  FFiscalTxt : Textfile;

  Linha,wvar : String;

  Nmarquivo : string;

  LN,CL:INT64;

  Excel : TExcelApplication;

  Const COLUNA:array[1..104] of string =('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',

  'AA','AB','AC','AD','AE','AF','AG','AH','AI','AJ','AK','AL','AM','AN','AO','AP','AQ','AR','AS','AT','AU','AV','AW','AX','AY','AZ',

  'BA','BB','BC','BD','BE','BF','BG','BH','BI','BJ','BK','BL','BM','BN','BO','BP','BQ','BR','BS','BT','BU','BV','BW','BX','BY','BZ',

  'CA','CB','CC','CD','CE','CF','CG','CH','CI','CJ','CK','CL','CM','CN','CO','CP','CQ','CR','CS','CT','CU','CV','CW','CX','CY','CZ');

begin

  Try

    CASE OPCAO OF

      0:

      begin

        Try

          Excel := TExcelApplication.Create(Application);

          Excel.Connect;

          Excel.Visible[0]:= True;

          Excel.WorkBooks.Add(Null,0);

        except

          MessageDlg('Esta operação não pode ser realizada.'+#13+#10+

                     'Sua máquina não possui o Excel instalado. Verifique!!!', mtWarning, [mbOK], 0);

        end;

        CL := 0; LN := 1;

        While (CL < DBGrid.Columns.Count) do

        begin

          Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Font.Bold := True;

          Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.Columns[CL].Title.Caption;

          CL := CL + 1;

        end;

        Try

          DBGrid.DataSource.DataSet.First;

          LN := 1;

          While not DBGrid.DataSource.DataSet.Eof DO

          begin

            LN := LN + 1;

            CL := 0;

            While (CL < DBGrid.Columns.Count) DO

            begin

              Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.Fields[CL].Value;

              CL := CL + 1;

            end;

            DBGrid.DataSource.DataSet.Next;

          end;

        Finally

          Excel.Columns.AutoFit;

          Excel.Disconnect;

          DBGrid.DataSource.DataSet.First;

        end;

        result := '1';

      end;

      1:

      begin

        Try

          Excel := TExcelApplication.Create(Application);

          Excel.Connect;

          Excel.Visible[0]:= True;

          Excel.WorkBooks.Add(Null,0);

        except

          MessageDlg('Esta operação não pode ser realizada.'+#13+#10+

                     'Sua máquina não possui o Excel instalado. Verifique!!!', mtWarning, [mbOK], 0);

        end;

        CL := 0; LN := 1;

        While (CL < DBGrid.DataSource.DataSet.FieldCount) do

        begin

          Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Font.Bold := True;

          Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.DataSource.DataSet.Fields[CL].FieldName;

          CL := CL + 1;

        end;

        Try

          DBGrid.DataSource.DataSet.First;

          LN := 1;

          While not DBGrid.DataSource.DataSet.Eof DO

          begin

            LN := LN + 1;

            CL := 0;

            While (CL < DBGrid.DataSource.DataSet.FieldCount) DO

            begin

              Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.DataSource.DataSet.Fields[CL].Value;

              CL := CL + 1;

            end;

            DBGrid.DataSource.DataSet.Next;

          end;

        Finally

          Excel.Columns.AutoFit;

          Excel.Disconnect;

          DBGrid.DataSource.DataSet.First;

        end;

        result := '1';

      end;

      2:

      begin

        if not DirExists('C:Meus Documentos') then

        begin

          MessageDlg('A pasta '+#39+'C:Meus Documentos'+#39+' não foi encontrado. Verifique !', mtInformation, [mbOK], 0);

          exit;

        end;

        if FileExists('C:Meus Documentos'+NomeArquivo+'.txt') then

        begin

          MessageDlg('O arquivo "C:Meus Documentos'+NomeArquivo+'.txt" já existe. Verifique!!!', mtWarning, [mbOK], 0);

          exit;

        end;

        Nmarquivo := 'C:Meus documentos'+NomeArquivo+'.txt';

        linha := '';

        CL := 0; LN := 1;

        While (CL < DBGrid.DataSource.DataSet.FieldCount) do

        begin

          linha := linha + DBGrid.DataSource.DataSet.Fields[CL].FieldName + '|';

          //Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.DataSource.DataSet.Fields[CL].FieldName;

          CL := CL + 1;

        end;

        AssignFile(FFiscaltxt,NmArquivo);                    

        try

          Rewrite(ffiscaltxt);            

          WriteLn(ffiscaltxt,linha);

        finally

          CloseFile(ffiscaltxt);

        end;

        Try

          DBGrid.DataSource.DataSet.First;

          LN := 1;

          While not DBGrid.DataSource.DataSet.Eof DO

          begin

            linha := '';

            LN := LN + 1;

            CL := 0;

            While (CL < DBGrid.DataSource.DataSet.FieldCount) DO

            begin

              linha := linha + DBGrid.DataSource.DataSet.Fields[CL].Text + '|';

              //Excel.Range[Coluna[Cl+1]+IntToStr(LN),Coluna[CL+1]+IntToStr(LN)].Value := DBGrid.DataSource.DataSet.Fields[CL].Value;

              CL := CL + 1;

            end;

            AssignFile(ffiscaltxt,nmArquivo);

            try

              Append(ffiscaltxt);

              WriteLn(ffiscaltxt,linha);

            finally

              CloseFile(ffiscaltxt);                    

            end;

            DBGrid.DataSource.DataSet.Next;

          end;

        FINALLY

          DBGrid.DataSource.DataSet.First;

        end;

        result := '1';

      end;

    END;// END do CASE

    if OPCAO = 2 THEN

      MessageDlg('Arquivo texto gerado em "C:Meus Documentos"'+#13+#10+

                 'Este arquivo poderá ser aberto no Excel.', mtWarning, [mbOK], 0);

  except

    if OPCAO <> 2 then // se for diferente de texto então é porque gerou para o excel

    begin

      MessageDlg('Houve falha na estrutura dos dados. O volume de informações deve ser grande.'+#13+#10+

                 'Tente gerar como arquivo texto. Caso não der certo, entrar em contato com a Z-Brasil.', mtWarning, [mbOK], 0);

    end

    else

      MessageDlg('Nome do arquivo não pode ter acentos. Verifique!!!', mtWarning, [mbOK], 0);

  end;

end;

/// Evento ONKEYDOWN DO COMPONENTE DBGRID = Ctrl + E

  if ((Key = 69) and (Shift = ([ssCtrl]))) then

  begin

    //Habilitar um componente RadioGroup da Guia Standard com estas opções

    //Somente Inf. da Grade (Excel)     //= 0

    //Todas as Inf. da Consulta (Excel) //= 1

    //Todas as Inf. da Consulta (Texto) //= 2  colocar um TEdit "NmArquivo" para informar o nome do arquivo texto a ser aberto no excel

    //Cancelar esta Operação            //= 3

    //////e também um Botão Button "Confirmar"

    CASE RgExportar.ItemIndex OF (0 = )

      0:FmMain.ExpGrid(ActiveControl.ClassType, DBGRID1, 0, NmArquivo.Text);

      1:FmMain.ExpGrid(DBGRID1.DataSource.DataSet.ClassType, DBGRID1, 1, NmArquivo.Text);

      2:FmMain.ExpGrid(DBGRID1.DataSource.DataSet.ClassType, DBGRID1, 2, NmArquivo.Text);

      3:EXIT;

    END;

  end;