Delphi DBGrid - Excel
¿Cómo estas? Mira tengo una pregunta, tengo un dbgrid y la informacion que contiene necesito pasarla a excel mediante un boton, no se que tan dificil o grande pueda ser el codigo, o si en realidad es sencillo.
Respuesta de gaunmanuel
1
1
gaunmanuel, Desarrollador de sistemas, delphi, SQL Interbase, Oracle
Si claro que si puedo ayudarte, te envio estas funciones, solo las pones en tu proyecto y mandas a llamar una de ellas y listo, ahi te va:
procedure TFrm_WhseTrailers.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].DisplayLabel + #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 TFrm_WhseTrailers.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;
end.
Ok mira estas son dos funciones pero la principal es la de SendToExcel la cual le pasas como parametros el nombre del Grid y la forma, te preguntaras porque la forma, bueno por lo general estas funciones las pones en una unidad a la que todas las formas tengan acceso, y entonces asi para no estar repitiendo estas funciones, pues le pasas como parametros la forma. Ok
La sintaxis es SendToExcel(DBGrid1, Form1); y listo pones esta linea en el OnClick del boton.
procedure TFrm_WhseTrailers.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].DisplayLabel + #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 TFrm_WhseTrailers.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;
end.
Ok mira estas son dos funciones pero la principal es la de SendToExcel la cual le pasas como parametros el nombre del Grid y la forma, te preguntaras porque la forma, bueno por lo general estas funciones las pones en una unidad a la que todas las formas tengan acceso, y entonces asi para no estar repitiendo estas funciones, pues le pasas como parametros la forma. Ok
La sintaxis es SendToExcel(DBGrid1, Form1); y listo pones esta linea en el OnClick del boton.
Hola de Nuevo, mira, intente ponerlo, pero me empezaron a salir muchos errores, me comentas que son funciones y el primer caso dice PROCEDURE, si pudieras explicarme que hacer paso por paso, porque no se como se hace, tal vez si se usara en una sola forma sin necesidad de llamarla, seria mas facil para mi, o no se, porque en mi forma solo tengo el dbgrid, un excelApplication del Tab de SERVERS, y el boton, te lo agradezco
Si Tienes razon se ma paso decirte que debes agregar, perdon ahi va:
1.- Primeramente por logica debes cambiar la clase a la que esta haciendo referencia :"TFrm_WhseTrailers." aqui tu debes poner la clase de tu forma, correcto si esta entendible, ¿no?
2. debes agregar la siguiente unidad a tu form en Uses agregas la unidad ComObj;
3. En tu form debes poner un componente llamado ExcelApplication, este componente lo encuentras en la pestaña de Servers de tu paleta de componentes, y listo es todo ahi ya te debe funcionar.
1.- Primeramente por logica debes cambiar la clase a la que esta haciendo referencia :"TFrm_WhseTrailers." aqui tu debes poner la clase de tu forma, correcto si esta entendible, ¿no?
2. debes agregar la siguiente unidad a tu form en Uses agregas la unidad ComObj;
3. En tu form debes poner un componente llamado ExcelApplication, este componente lo encuentras en la pestaña de Servers de tu paleta de componentes, y listo es todo ahi ya te debe funcionar.
No te preocupes puedes preguntar cuantas veces deses hasta que salga.
Bueno mira efectivamente te va a marcar error porque no le estas definiendo la clase al procedure, pero no te preocupes en ves de self ponle el nombre de la variable asi:
mem := TMemo.Create(mem);
Mem ya esta declarado de tipo TMemo asi que esto te debe crear el componente.
Bueno mira efectivamente te va a marcar error porque no le estas definiendo la clase al procedure, pero no te preocupes en ves de self ponle el nombre de la variable asi:
mem := TMemo.Create(mem);
Mem ya esta declarado de tipo TMemo asi que esto te debe crear el componente.
- Compartir respuesta
- Anónimo
ahora mismo