Autor Beitrag
galbe19
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 56



BeitragVerfasst: Mo 17.11.08 16:44 
hallo

ich generiere folgenderweise eine excel Tabelle
Function tform1.ExportToExcel(oDataSet : TDataSet; sFile,text : String): Boolean;
var iCol,iRow : Integer;

oExcel : TExcelApplication;
oWorkbook : TExcelWorkbook;
oSheet : TExcelWorksheet;
begin
iCol := 0;
iRow := 0;
result := True;

oExcel := TExcelApplication.Create(Application);
oWorkbook := TExcelWorkbook.Create(Application);
oSheet := TExcelWorksheet.Create(Application);

try
oExcel.Visible[0] := False;
oExcel.Connect;
except
result := False;
MessageDlg('Excel may not be installed', mtError, [mbOk], 0);
exit;
end;

//To make Excel visible.
oExcel.Visible[0] := False;

//Document title.
oExcel.Caption := 'This is the document title';
oExcel.Workbooks.Add(Null,0);

oWorkbook.ConnectTo(oExcel.Workbooks[1]);
oSheet.ConnectTo(oWorkbook.Worksheets[1] as _Worksheet);

iRow := 1;

//To write the fileds names.
for iCol:=0 to oDataSet.FieldCount-1 do begin
oSheet.Cells.Item[iRow,iCol+1] := oDataSet.FieldDefs.Items[iCol].Name;
oSheet.Cells.Item[iRow,iCol+1] := oDataSet.Fields[iCol].FieldName;
end;

oDataSet.Open;
while NOT oDataSet.Eof do begin
Inc(iRow);

for iCol:=1 to oDataSet.FieldCount do begin
oSheet.Cells.Item[iRow,iCol] := oDataSet.Fields[iCol-1].AsString;
end;

oDataSet.Next;
end;

//Change the wprksheet name.
oSheet.Name := Text;

//Change the font properties of all columns.
oSheet.Columns.Font.Color := clBlack;
oSheet.Columns.Font.FontStyle := fsBold;
oSheet.Columns.Font.Size := 10;

//Auto fit all columns.
oSheet.Columns.AutoFit;

//Delete file if exists.
DeleteFile(sFile);

oSheet.SaveAs(sFile);
oSheet.Disconnect;
oSheet.Free;

oWorkbook.Disconnect;
oWorkbook.Free;

oExcel.Quit;
oExcel.Disconnect;
oExcel.Free;
end;

mein problem ist dass die Excel tabelle falsch ist und zwar
er exportiert manche mit , und manche mit.
CBM falsch cbm korrekt
49,68 49,68
2.345 2,345
1.407 usw
0,138
8.978
1.048

weiss jemand warum

mfg
Alex
Chemiker
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 194
Erhaltene Danke: 14

XP, Vista 32 Bit, Vista 64 Bit, Win 7 64 Bit
D7, BDS 2006, RAD Studio 2009+C++, Delphi XE2, XE3, VS 2010 Prof.
BeitragVerfasst: Mo 17.11.08 20:14 
Hallo galbe19,

Du überträgst die Daten als String, aber es sind Zahlen. Wenn Du den String in das richtige Format in Excel überträgst sollte es eigentlich funktionieren, sonst interpretiert Excel für Dich die Daten und dann kommt es manchmal zu Fehlinterpretationen.

Bis bald Chemiker
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1248
Erhaltene Danke: 187

XP - Server 2008R2
D2 - Delphi XE
BeitragVerfasst: Di 18.11.08 13:59 
Titel: Alternativer Vorschlag, ist auch wesentlich schneller
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