Hallo,
ich übertrage Daten üblicherweise nicht Zellenweise sondern über die Zwischenablage als Block.
Ungeachtet dessen wie es implementieren möchtest kannst Du gegf. Auszüge wie das setzen der Splatenformatierengen für Dich brauchen. (ACHTUNG gegf. anpassen / Fomat / Lokalisierung)
Procedure AddExcelSelectionBorders(XLS:Variant;WithInner:Boolean=true);
Const
xlEdgeLeft=7;
xlEdgeTop=8;
xlEdgeBottom=9;
xlEdgeRight=10;
xlInsideVertical=11;
xlInsideHorizontal=12;
begin
XLS.Selection.Borders[xlEdgeLeft].LineStyle := 1;
XLS.Selection.Borders[xlEdgeTop].LineStyle := 1;
XLS.Selection.Borders[xlEdgeBottom].LineStyle := 1;
XLS.Selection.Borders[xlEdgeRight].LineStyle := 1;
if WithInner then
begin
try
XLS.Selection.Borders[xlInsideVertical].LineStyle := 1;
except end;
try
XLS.Selection.Borders[xlInsideHorizontal].LineStyle := 1;
except end;
end;
end;
Function NewExcelWorkBook:Variant;
begin
Result:=CreateOLEObject('Excel.Application');
end;
//______________________________________________________________________________
Function AddExcelWorkBook(XLS:Variant;Pages:Integer=1):Variant;
begin
Result := XLS.WorkBooks.Add;
While XLS.Sheets.Count>Pages do XLS.Sheets[1].Delete;
While XLS.Sheets.Count>Pages do XLS.Sheets.Add;
end;
Procedure SetClipboardTable4Excel(Ads:TAdodataset;WithHeader:Boolean=true);
var
sl:TStringList;
i:Integer;
s:String;
Const
sep=#9;
Function RemoveInvalid(const s:String):String;
begin
Result := StringReplace(StringReplace(StringReplace(s,#13,' ',[rfReplaceAll])
,#10,'',[rfReplaceAll])
,sep,' ',[rfReplaceAll]);
end;
begin
sl:=TStringList.Create;
s:='';
Ads.First;
if WithHeader then
begin
For i:= 0 to Ads.FieldCount - 1 do
if Ads.Fields[i].Visible then
begin
s:=s + Ads.Fields[i].DisplayLabel + Sep;
end;
s:=Copy(s,1,length(s) - Length(sep));
sl.Add(s);
end;
While not Ads.Eof do
begin
s:='';
For i:= 0 to Ads.FieldCount - 1 do
if Ads.Fields[i].Visible then
begin
if (Ads.Fields[i].DataType=ftMemo) or (Ads.Fields[i].DataType=ftWideMemo) then s:=s + RemoveInvalid(Ads.Fields[i].asString) + Sep
else s:=s + RemoveInvalid(Ads.Fields[i].DisplayText) + Sep;
end;
s:= Copy(s,1,length(s) - Length(sep));
sl.Add(s);
Ads.Next;
end;
ClipBoard.SetTextBuf(Pchar(sl.Text));
sl.Free;
end;
Procedure PasteToExcelSheet(XLS:Variant;Sheet:Integer;Const Labeltext:String;ColorizeHeader:Boolean=true
;Autosize:Boolean=true;WithBorders:Boolean=true;FontSize:Integer=0;FreezeHeader:Boolean=true);
begin
XLS.Sheets[Sheet].Select;
If Length(Labeltext)>0 then XLS.Sheets[Sheet].Name := Labeltext;
XLS.Sheets[Sheet].Paste;
if FontSize> 0 then XLS.Selection.Font.Size := FontSize;
If WithBorders then
begin
AddExcelSelectionBorders(XLS);
end;
if ColorizeHeader then
begin
XLS.Rows.Item[1].Select;
XLS.Selection.Interior.Color := clSilver;
end;
if AutoSize then XLS.Sheets[Sheet].Columns.EntireColumn.AutoFit;
if FreezeHeader then
begin
XLS.Sheets[Sheet].Activate;
XLS.Sheets[Sheet].Range['A2'].Select;
XLS.ActiveWindow.FreezePanes := true;
XLS.Sheets[Sheet].PageSetup.PrintTitleRows := '$1:$1'
end;
end;
Function GetNumberFormat(f:TField):String;
begin
case f.DataType of
ftAutoInc: Result := '#.##0';
ftUnknown: Result := '@';
ftString: Result := '@';
ftSmallint: Result := '#.##0';
ftInteger: Result := '#.##0';
ftWord: Result := '#.##0';
ftBoolean: Result := '@';
ftFloat: Result := '#.##0,00';
ftCurrency: Result := '#.##0,00 $';
ftBCD: Result := '#.##0,00';
ftDate: Result := 'TT.MM.JJJJ';
ftTime: Result := 'hh:mm:ss';
ftDateTime: Result:= 'TT.MM.JJJJ';
else Result := '@';
end;
end;
Procedure SetColFormat(XLS:Variant;Ads:TAdodataset);
var
i:Integer;
j:Integer;
a:String;
begin
j := 0;
for I := 0 to Ads.FieldCount - 1 do
begin
if Ads.Fields[i].Visible then
begin
inc(j);
XLS.Columns[j].Select;
a := GetNumberFormat(Ads.Fields[i]);
try
XLS.Selection.NumberFormat := GetNumberFormat(Ads.Fields[i]);
except
Showmessage(Ads.Fields[i].FieldName+'-'+ GetNumberFormat(Ads.Fields[i]));
end;
end;
end;
end;
Procedure ExportADS2Excel(Ads:TAdodataset;Const TheCaption:String='';WithHeader:Boolean=true;DoOnlyPrint:Boolean=false);
var
XLS,WB:Variant;
begin
XLS := NewExcelWorkBook;
WB := AddExcelWorkBook(XLS,1);
SetColFormat(XLS,ADS);
XLS.Cells[1,1].Select;
SetClipboardTable4Excel(Ads,true);
PasteToExcelSheet(XLS,1,TheCaption,true,true,true,0,true);
if DoOnlyPrint then
begin
Try
WB.PrintOut(ActivePrinter:= Printer.Printers[Printer.PrinterIndex]);
finally
XLS.Application.DisplayAlerts := False;
XLS.Quit;
end;
end
else XLS.Visible:=true;
end;
MfG
bummi
www.explido-software.de