|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Kopiera ett TDBGrid till Excel
|
Kategori: Objekt/ActiveX
Inlagt: 2004-01-06
Läst: 1299
Inlagt av: Pär
|
|
Beskrivning |
|
En procedure som kopierar vad du ser i ett TDBGrid till Excel. Du kan använda kalkylerade fält i queryn eller vad du vill, vad som kopieras till Excel beror på hur du configurerat visningen av datan i TDBGriden. Med variabeln bMultiSel meddelar du om Griden har MultiSelect satt till True eller False.
|
|
Kod |
uses Registry, ComObj, Excel97
...
...
procedure TForm1.SendDBGridToExcel(aDbGrid: TDBGrid; pMultiSel: Boolean);
var
Reg: TRegistry;
bOk: Boolean;
xls, wb, Range: OLEVariant;
ArrData: Variant;
iRows, iCols, i, j, x, y: Integer;
Book: TBookMark;
aDataSet: TDataSet;
sFormat: String;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
bOk := Reg.KeyExists('Excel.Application');
finally
Reg.Free;
end;
if not bOk then
begin
ShowMessage('Excel inte installerat.');
Exit;
end;
aDataSet := aDbGrid.DataSource.DataSet;
iRows := aDataSet.RecordCount + 1;
iCols := aDbGrid.Columns.Count;
ArrData := VarArrayCreate([1,iRows,1,iCols],varVariant);
for i := 0 to aDbGrid.Columns.Count - 1 do
ArrData[1,i+1] := aDbGrid.Columns[i].Title.Caption;
x := 2;
try
Book := aDataSet.GetBookmark;
if not pMultiSel then
aDbGrid.Options := aDbGrid.Options + [dgMultiSelect];
aDataSet.First;
for i := 0 to aDataSet.RecordCount - 1 do
begin
aDbGrid.SelectedRows.CurrentRowSelected := True;
aDataSet.Next;
end;
with aDbGrid.DataSource.DataSet do
begin
for i := 0 to aDbGrid.SelectedRows.Count - 1 do
begin
GotoBookmark(pointer(aDbGrid.SelectedRows.Items[i]));
for j := 0 to aDbGrid.Columns.Count - 1 do
ArrData[x,j+1] := aDbGrid.Columns[j].Field.AsString;
Inc(x);
end;
end;
aDataSet.GotoBookmark(Book);
aDataSet.FreeBookmark(Book);
if not pMultiSel then
aDbGrid.Options := aDbGrid.Options - [dgMultiSelect];
except end;
try
xls := CreateOLEObject('Excel.Application');
wb := xls.Workbooks.Add;
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1],
wb.WorkSheets[1].Cells[1,iCols]];
Range.font.bold := True;
for i := 0 to aDbGrid.Columns.Count - 1 do
begin
if aDbGrid.Columns[i].Field.DataType = ftString then
begin
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1,i+1],
wb.WorkSheets[1].Cells[iRows,i+1]];
Range.NumberFormat := '@';
end
else
if aDbGrid.Columns[i].Field.DataType = ftFloat then
begin
sFormat := '';
for j := 0 to aDataSet.FieldCount - 1 do
begin
if aDataSet.Fields[j].Name = aDataSet.Name+aDbGrid.Columns[i].FieldName then
begin
sFormat := TFloatField(aDataSet.Fields[j]).DisplayFormat;
Break;
end;
end;
if sFormat = '' then
sFormat := '#.##0,########'
else
begin
j := Length(Copy(sFormat,Pos('.',sFormat)+1,Length(sFormat)));
sFormat := '#.##0,';
For y := 1 to j do
sFormat := sFormat + '0';
end;
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1,i+1],
wb.WorkSheets[1].Cells[iRows,i+1]];
Range.NumberFormat := sFormat;
end
else
if aDbGrid.Columns[i].Field.DataType = ftInteger then
begin
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1,i+1],
wb.WorkSheets[1].Cells[iRows,i+1]];
Range.NumberFormat := '0';
end;
end;
Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1],
wb.WorkSheets[1].Cells[iRows,iCols]];
Range.Value := ArrData;
xls.Visible := True;
except
ShowMessage('Error - Export till Excel.');
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendDBGridToExcel(DbGrid1,False);
end;
|
|
|