Error en exportar datos de un dbgrid a excel

¿Pero cuál es el error?
mem.Parent := forma; esto es para que el memo que crea dinamicamente lo cree en la forma donde estas trabajando...
Y LetraRango ... este simplemente obtiene el rango que que se va a pintar en excel segun la cantidad de campos que tenga tu DBGrid.
¿Ahora dime cual error te marca o en que linea?

mira primeramente explicare como es mi programa bueno primero yo estoy metiendo informacion a unos dbedits de alli la informaCION de los dbedits la mando a un dbgrid teniendo en cuenta que no tengo base de datos ni nada de eso solo informacion ke pasa de unos debedits a un dbgrid y de alli kiero mandar los datos a excel pero me marca errores no se si sea nesesario un ole o para que me sirve el ado la verdad nesesito saber como se maneja el codigo porque soy principiante en esto podrias ayudarme tu como experto enviandome tu el codigo por aqui por el correo por favor ayudame ya que nesesito tener mi trabajo como por el 8 de octubre por favor
gracias y saludos

mira de nuevo yo , encontre en internet un codigo de como pasar la informacion de un dbgrid a excel este es ...peroooo el asunto es que nesesito scrollevents y pues no se como sacar esos componentes por eso me gusta mas tu codigo por favor has la prueba con tu codigo y me podrias ayudar?
unit DBGridExportToExcel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;
type TScrollEvents = class
BeforeScroll_Event: TDataSetNotifyEvent;
AfterScroll_Event: TDataSetNotifyEvent;
AutoCalcFields_Property: Boolean;
end;
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
implementation
//Support procedures
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
DisableControls;
ScrollEvents := TScrollEvents.Create();
with ScrollEvents do
begin
BeforeScroll_Event := BeforeScroll;
AfterScroll_Event := AfterScroll;
AutoCalcFields_Property := AutoCalcFields;
BeforeScroll := nil;
AfterScroll := nil;
AutoCalcFields := False;
end;
end;
end;
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
EnableControls;
with ScrollEvents do
begin
BeforeScroll := BeforeScroll_Event;
AfterScroll := AfterScroll_Event;
AutoCalcFields := AutoCalcFields_Property;
end;
end;
end;
//This is the procedure which make the work:
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
var
cat: _Catalog;
tbl: _Table;
col: _Column;
i: integer;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
ScrollEvents: TScrollEvents;
SavePlace: TBookmark;
begin
//
//WorkBook creation (database)
cat := CoCatalog.Create;
cat._Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0;
Data Source=' + FileName + ';Extended Properties=Excel 8.0');
//WorkSheet creation (table)
tbl := CoTable.Create;
tbl.Set_Name(SheetName);
//Columns creation (fields)
DBGrid.DataSource.DataSet.First;
with DBGrid.Columns do
begin
for i := 0 to Count - 1 do
if Items.Visible then
begin
col := nil;
col := CoColumn.Create;
with col do
begin
Set_Name(Items.Title.Caption);
Set_Type_(adVarWChar);
end;
//add column to table
tbl.Columns.Append(col, adVarWChar, 20);
end;
end;
//add table to database
cat.Tables.Append(tbl);
col := nil;
tbl := nil;
cat := nil;
//exporting
ADOConnection := TADOConnection.Create(nil);
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;
Data Source=' + FileName + ';Extended Properties=Excel 8.0';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
ADOQuery.Open;
DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
try
with DBGrid.DataSource.DataSet do
begin
First;
while not Eof do
begin
ADOQuery.Append;
with DBGrid.Columns do
begin
ADOQuery.Edit;
for i := 0 to Count - 1 do
if Items.Visible then
begin
ADOQuery.FieldByName(Items.Title.Caption).AsString :=
FieldByName(Items.FieldName).AsString;
end;
ADOQuery.Post;
end;
Next;
end;
end;
finally
DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
ADOQuery.Close;
ADOConnection.Close;
ADOQuery.Free;
ADOConnection.Free;
end;
end;
end.

El punto es que yo te o envie exactamente como yo lo estoy usando, y en este momento esta siendo utilizado en sistema en la empresa en la que trabajo, y funciona buen, dime exactamente que te marca y en que linea... para ver que te esta haciendo falta. Ok

procedure SendToExcel(Grid:TDBGrid;Forma:TForm);
var
bm: TBookmark;
col, row, renExcel: Integer;
sline, LetraRango, rango: String;
mem: TMemo;
ExcelApp: Variant;
Format : OleVariant;
Evento:TDataSetNotifyEvent;
ToExcel:Boolean;
begin
ToExcel := true;
Screen.Cursor := crHourglass;
Grid.DataSource.DataSet.DisableControls;
bm := Grid.DataSource.DataSet.GetBookmark;
Grid.DataSource.DataSet.First;
-----------------------------------------------------------------------------------------
* mira aqui me sale un error dice (error)form1.pas(7992)undeclarer indetifier:'createoleobject'
creo que es algo del ole o no se si de excel.application puedes explicarme esa linea o
ayudarme a decirme el error?
ExcelApp := CreateOleObject('Excel.Application');
-------------------------------------------------------------------------------------------
ExcelApp.WorkBooks.Add($FFFFEFB9);
ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Sheet1';
Grid.DataSource.DataSet.First;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Select;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Font.FontStyle := 'Bold';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Font.Color := clNavy;
ExcelApp.Range['A2', 'A2'].Value:='Contenedor:';
ExcelApp.Range['B2', 'B2'].Value:=Grid.DataSource.DataSet.FieldByName('Contenedor').AsString;
mem := TMemo.Create(Self);
mem.Visible := false;
mem.Parent := Forma;
mem.WordWrap := false;
mem.Clear;
sline := '';
for col := 0 to Grid.FieldCount-1 do
sline := sline + Grid.Fields[col].DisplayLabel + #9;
mem.Lines.Add(sline);
if toExcel then
begin
---------------------------------------------------------------------------
* AQUI ME SALE OTRO ERROR PERO NO SE SI SEA POR EL ULTIMO CODIGO DONDE DICE FUNCTION QUE PUSISTE PARA
LETRARANGO SI ES EL CODIGO ME PODRIAS DECIR DONDE SE PONE EL CODIGO .EN UN EJEMPLO
LetraRango := GetLetraRango(Grid.FieldCount);
------------------------------------------------------------------------------------------
mem.SelectAll;
mem.CopyToClipBoard;
rango := 'A3:' + LetraRango + '3';
renExcel := 3;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Font.FontStyle := 'Bold';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Font.Color := clBlack;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
mem.Lines.Clear;
end;
if assigned(Grid.DataSource.DataSet.AfterScroll) then
begin
Evento:=Grid.DataSource.DataSet.AfterScroll;
Grid.DataSource.DataSet.AfterScroll:=nil;
end;
Grid.DataSource.DataSet.DisableControls;
for row := 0 to Grid.DataSource.DataSet.RecordCount-1 do
begin
sline := '';
for col := 0 to Grid.FieldCount-1 do
sline := sline + Grid.Fields[col].AsString + #9;
mem.Lines.Add(sline);
Grid.DataSource.DataSet.Next;
if toExcel then
if mem.Lines.Count = 100 then
begin
mem.SelectAll;
mem.CopyToClipBoard;
rango := 'A' + IntToStr(renExcel+1) + ':' + LetraRango + IntToStr(renExcel+1+mem.Lines.Count-1);
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
Format := '@';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].NumberFormat := Format;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
renExcel := renExcel + mem.Lines.Count;
mem.Lines.Clear;
end;
end;
if mem.Lines.Count > 0 then
begin
mem.SelectAll;
mem.CopyToClipboard;
if toExcel then
begin
rango := 'A' + IntToStr(renExcel+1) + ':' + LetraRango + IntToStr(renExcel+1+mem.Lines.Count-1);
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
Format := '@';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].NumberFormat := Format;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A3:A3'].Select;
ExcelApp.Visible := true;
end;
end;
Grid.DataSource.DataSet.AfterScroll:=Evento;
Grid.DataSource.DataSet.EnableControls;
mem.Free;
Grid.DataSource.DataSet.GotoBookmark(bm);
Grid.DataSource.DataSet.FreeBookmark(bm);
Grid.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
//------------------------------------------------------------------------------
// obtener el rango en excel para el dataset a exportar
function GetLetraRango(NumCampos: Integer): String;
const
elementos = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
begin
if NumCampos < 27 then
Result:= elementos[NumCampos]
else
begin
Result:=elementos[(NumCampos - 1) div 26];
Result:=Result + elementos[((NumCampos - 1) mod 26)+1];
end;
end;
Son dos funcion pero la principal es la de SendToExcel y le pasas como parametros el nombre del DBGrid y de la forma donde se encuentra el DBGrid, deberas poner en el uses ComObj;
***LA SEGUNDA FUNCION DONDE LA PONGO? DIMELO CON UN EJEMPLO PORFAVOR Y LA *FUNCION UNO LA PONGO EN UN BOTONPARA QUE REALIZE LA ACCION?

** OTRA PREGUNTA O DUDA MAS BIEN PUES MI DUDA ES QUE SIGNIFICA 'CONTENEDOR' ABAJO TE MUESTRO A QUE PARTE ME REFIERO
procedure SendToExcel(Grid:TDBGrid;Forma:TForm);
var
bm: TBookmark;
col, row, renExcel: Integer;
sline, LetraRango, rango: String;
mem: TMemo;
ExcelApp: Variant;
Format : OleVariant;
Evento:TDataSetNotifyEvent;
ToExcel:Boolean;
begin
ToExcel := true;
Screen.Cursor := crHourglass;
Grid.DataSource.DataSet.DisableControls;
bm := Grid.DataSource.DataSet.GetBookmark;
Grid.DataSource.DataSet.First;
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.WorkBooks.Add($FFFFEFB9);
ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Sheet1';
Grid.DataSource.DataSet.First;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Select;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Font.FontStyle := 'Bold';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A2:B2'].Font.Color := clNavy;
///////////////////////////////////////////////////////////////////////////////////////////////
//// ExcelApp.Range['A2', 'A2'].Value:='Contenedor:'; ////
/// ExcelApp.Range['B2', 'B2'].Value:=Grid.DataSource.DataSet.FieldByName('Contenedor').AsString; ////
///////////////////////////////////////////////////////////////////////////////////////////////
mem := TMemo.Create(Self);
mem.Visible := false;
mem.Parent := Forma;
mem.WordWrap := false;
mem.Clear;
sline := '';
for col := 0 to Grid.FieldCount-1 do
sline := sline + Grid.Fields[col].D
isplayLabel + #9;
mem.Lines.Add(sline);
if toExcel then
begin
LetraRango := GetLetraRango(Grid.FieldCount);
mem.SelectAll;
mem.CopyToClipBoard;
rango := 'A3:' + LetraRango + '3';
renExcel := 3;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Font.FontStyle := 'Bold';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Font.Color := clBlack;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
mem.Lines.Clear;
end;
if assigned(Grid.DataSource.DataSet.AfterScroll) then
begin
Evento:=Grid.DataSource.DataSet.AfterScroll;
Grid.DataSource.DataSet.AfterScroll:=nil;
end;
Grid.DataSource.DataSet.DisableControls;
for row := 0 to Grid.DataSource.DataSet.RecordCount-1 do
begin
sline := '';
for col := 0 to Grid.FieldCount-1 do
sline := sline + Grid.Fields[col].AsString + #9;
mem.Lines.Add(sline);
Grid.DataSource.DataSet.Next;
if toExcel then
if mem.Lines.Count = 100 then
begin
mem.SelectAll;
mem.CopyToClipBoard;
rango := 'A' + IntToStr(renExcel+1) + ':' + LetraRango + IntToStr(renExcel+1+mem.Lines.Count-1);
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
Format := '@';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].NumberFormat := Format;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
renExcel := renExcel + mem.Lines.Count;
mem.Lines.Clear;
end;
end;
if mem.Lines.Count > 0 then
begin
mem.SelectAll;
mem.CopyToClipboard;
if toExcel then
begin
rango := 'A' + IntToStr(renExcel+1) + ':' + LetraRango + IntToStr(renExcel+1+mem.Lines.Count-1);
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].Select;
Format := '@';
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range[rango].NumberFormat := Format;
ExcelApp.Workbooks[1].WorkSheets['Sheet1'].Paste;
ExcelApp.WorkBooks[1].WorkSheets['Sheet1'].Range['A3:A3'].Select;
ExcelApp.Visible := true;
end;
end;
Grid.DataSource.DataSet.AfterScroll:=Evento;
Grid.DataSource.DataSet.EnableControls;
mem.Free;
Grid.DataSource.DataSet.GotoBookmark(bm);
Grid.DataSource.DataSet.FreeBookmark(bm);
Grid.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
//------------------------------------------------------------------------------
// obtener el rango en excel para el dataset a exportar
function GetLetraRango(NumCampos: Integer): String;
const
elementos = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
begin
if NumCampos < 27 then
Result:= elementos[NumCampos]
else
begin
Result:=elementos[(NumCampos - 1) div 26];
Result:=Result + elementos[((NumCampos - 1) mod 26)+1];
end;
end;
Son dos funcion pero la principal es la de SendToExcel y le pasas como parametros el nombre del DBGrid y de la forma donde se encuentra el DBGrid, deberas poner en el uses ComObj;

Ok mira son 2 funciones uno es SendToExcel que seria la principal y la otra funcion es GetLetraRango la cual es usada por la primera funcion.
Digamos que tienes una forma llamada Form1, ok.
Estas dos funciones las pones en esa unidad de la Form1,
primero las declares en el public
procedure SendToExcel(Grid:TDBGrid; Forma:TForm);
function GetLetraRango(NumCampos:Integer):string;
asi se declaran ok.
Luego las pones abajo en el codigo asi:
procedure TForm1.SendToExcel(Grid:TDBGrid; Forma:TForm);
Begin
//Aqui pones todo el codigo de este procedimiento que ya te envie ok.
End;
function TForm1.GetLetraRango(NumCampos:Integer):string;
Begin
//Aqui pones el codigo de la funcion letraRango que ya te envie tambien, ok.
end;
Recuerda que en Uses de la parte de arriba de unidad, deberas poner la libreria comObj; ok.
Bueno una vez hecho esto como la mandamos ejecutar:
Suponiendo que en to Form1 ya tienes un TDBGrid llamado DBGrid1 y tambien tienes un boton.
Dentro del onClick del boton pones la siguiente linea:
SendToExcel(DBGrid1,Form1);
Y listo es todo, si te das cuenta le pasamos como parametro el nombre del DBGrid y el nombre de tu forma.
Y es todo checalo.