السلام عليكم
بارك الله فيك
المشكلة في نسخة Office المستعلمة، أنت استعملت وحدة النسخة excel97 والتي معي في Delphi7 هي ExcelXP.
أيضا غيرت EmptyParam الى EmptyStr.
مع حذف الوحدة Outline فهي غير ضرورية، وكذلك DirOutln وSpin وCalendar وOleServer
الطريقة جميلة وديناميكية، إلا أنها نوعا ما ثقيلة.
شكرا كثيرا.
تم تحسين الكود إلى الأفضل حيث أصبحت سرعة نقل البيانات سريعة جدا
كود :
PROCEDURE ExportDataSetToExcel;(DataSet: Tdataset;Orientation,TitleColor,TitleFontSize,DataFontSize:integer;LineStyle: XlLineStyle);
VAR
XLApp : TexcelApplication;
Classeur : _workbook;
Feuille : _worksheet;
i,j,lin,col : integer;
FormTmp : TForm;
Label1,Label2 : TLabel;
Matrix : Variant;
BookMark : TBookmark;
//----------------------------------------------
FUNCTION AdrsStr(Lin,col:Integer): string;
const T ='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var i,j,x: integer; TT: array[1..729] of string[2];
BEGIN
FOR i:=1 TO 26 DO TT[i]:=T[i];
x:=27;
FOR i:=1 TO 26 DO for j:=1 to 26 do
BEGIN TT[x]:=T[i]+T[j]; x:=x+1; END;
Result:=tt[COL]+inttostr(LIN);
END;
//-------------------------------------------
BEGIN
Application.CreateForm(TForm, Formtmp);
WITH FormTmp DO
BEGIN
Position := poScreenCenter; BorderIcons := [bisystemMenu];
//FormStyle := fsStayOnTop;
Width:=370;Height := 120;
Caption := ' Exporter des données vers Excel ... ';
END;
Label1 :=TLabel.Create(nil);
WITH (label1) DO
BEGIN
Name := 'label1'; Caption := 'copie l''enregistrement ';
parent := Formtmp; Align := altop;
Font.Size := 16; Font.Style := [Fsbold];
Alignment := taCenter; Height := 40;
END;
Label2 :=TLabel.Create(nil);
WITH (label2) DO
BEGIN
Name := 'label2'; Caption := 'Veuillez Patientez SVP ';
parent := Formtmp; Align := altop;
Font.Size := 12; Font.Style := [Fsbold];
Font.Color := clred; Alignment := taCenter; Height := 40;
END;
IF MessageDlg('Etes-vous sûr de vouloir copie cette liste sur une feuille Excel ?', mtConfirmation , mbYesNoCancel ,0) = mryes THEN
BEGIN
FORMTMP.Show;
// Formtmp.Update;
XLApp := TExcelApplication.Create(Application);
TRY
Xlapp.Connect;
EXCEPT
Showmessage('Echec de connection vers Excel...!!!');
Formtmp.Close; Formtmp.free; XLApp.free;
exit;
END;
Classeur := XlApp.Workbooks.Add(EmptyParam,0);
Feuille := Classeur.Worksheets[1] as _worksheet;
lin := dataset.RecordCount+1; // Nombre des lignes dans la source de données "datset"
col := dataset.Fields.Count; // Nombre des champs dans la source de données
// Déclaré un tableau deux dimension Lin X Col Array [lin,col] de type varie
// peut avoir n'importe quelle valeur
matrix := VarArrayCreate([0,lin,0,col], varVariant );
//Orienter la page excel gaucheDroite(0) ou droitegauche(1)
TRY feuille.DisplayRightToLeft[1]:= Orientation; EXCEPT END;
Formtmp.Update;
//Charger l'entete de fichier (nom ou displayName de DataSet
FOR i:=0 TO col-1 DO
matrix[0,i]:= ReplaceStr(dataset.Fields[i].DisplayName,'-_()',' ');;
Dataset.DisableControls; // Désactivé les controls sur dataset pour accélérer le parcour
BookMark := dataset.GetBookmark; // Sauvgarder la postition de pointeur sur l'eneregistrement encoure
dataset.First;
j:=1;
WHILE NOT dataset.Eof DO
BEGIN
// Charger le contenu de l'eneregistrement encoure dans la matrice Matrix
FOR i:=0 TO col-1 DO
TRY matrix[j,i]:=dataset.Fields[i].Value;EXCEPT END;
label1.Caption := 'copie l''eneregistrement '+inttostr(j)+'/'+inttostr(lin-1);
Formtmp.Update;
dataset.next;
j:=j+1;
END;;
// Remplire La feuille excel par le contenu de la matrice Matrix
XLApp.EnableEvents := false;
feuille.Range[AdrsStr(1,1),AdrsStr(lin,col)].value := matrix;
// mise en forme la feuille excel font de titre et le contenu
WITH feuille.Range[AdrsStr(1,1),AdrsStr(1,col)] DO
BEGIN Interior.Color:=titlecolor;Font.Size:=titlefontsize;END;
WITH feuille.Range[AdrsStr(1,1),AdrsStr(lin,col)] DO
BEGIN Font.Size:=datafontsize;Borders.LineStyle:=linestyle;END;
XLApp.EnableEvents := true;
dataset.GotoBookmark(BookMark);
Dataset.EnableControls;
Label2.Caption :='Copie des données Terminé...';
ShowMessage('Copie des données Terminé...');
XLApp.Visible[1]:=true ;
TRY
Feuille.Activate(1);
EXCEPT
END;
XLApp.Disconnect;
XLApp.free;
VarClear(Matrix);
formtmp.Close;
Formtmp.free;
END ELSE BEGIN Formtmp.Close;Formtmp.free; END;
END;
كل من 1 user says قال شكرا ل getsource على المشاركة المفيدة1 user says Thank You to getsource for this post • أبو معاذ
18-07-2010, 07:53 PM (آخر تعديل لهذه المشاركة: 10-12-2010, 07:35 AM بواسطة kachwahed.)
الإجراء الذي أرفقته يستخدم المكتبة Excel97 وتابع ReplaceStr معرف في إحدى وحداتك الخاصة
هنا إجراء لنقل البيانات من TDBGrid إلى Excel باستخدام الوحدة Excel2000 المرفقة مع دلفي:
كود :
uses
ComObj, ActiveX, Excel2000; // or Excel97
//Excel2000 can be found in '%ProgramFiles%\Borland\Delphi7\Ocx\Servers'
procedure SendToExcel(aDataSet: TDataSet);
var
PreviewToExcel: TExcelApplication;
RangeE: ExcelRange; //or RangeE: Excel97.Range
I, Row: integer;
Bookmark: TBookmarkStr;
begin
PreviewToExcel := TExcelApplication.Create(nil); //Or TExcelApplication.Create(Application)
PreviewToExcel.Connect;
PreviewToExcel.Workbooks.Add(NULL, 0);
RangeE := PreviewToExcel.ActiveCell;
for I := 0 to aDataSet.Fields.Count - 1 do
begin
RangeE.Value := aDataSet.Fields[I].DisplayLabel;
RangeE := RangeE.Next;
end;
aDataSet.DisableControls;
try
Bookmark := aDataSet.Bookmark;
try
aDataSet.First;
Row := 2;
while not aDataSet.EOF do
begin
//Write down Record As Row in msExcel
RangeE := PreviewToExcel.Range['A' + IntToStr(Row), 'A' + IntToStr(Row)];
for I := 0 to aDataSet.Fields.Count - 1 do
begin
RangeE.Value := aDataSet.Fields[I].AsString;
RangeE := RangeE.Next;
end;
aDataSet.Next;
Inc(Row);
end;
finally
aDataSet.Bookmark := Bookmark;
end;
finally
aDataSet.EnableControls;
end;
//Creating Preview from Range A1..ColumnX
//Calculating ASCII 64 (Character Before "A") With Dataset FieldsCount
//This Method can only handle range A1..Z?, if want to be excel column type
//support, exp "AA"/"IV"
RangeE := PreviewToExcel.Range['A1', chr(64 + aDataSet.Fields.Count) + IntToStr(Row - 1)];
RangeE.AutoFormat(8, NULL, NULL, NULL, NULL, NULL, NULL);
PreviewToExcel.Visible[0] := True;
PreviewToExcel.Disconnect;
end;
في المرفقات مكتبة uExportToExcel للقيام بنفس العمل مع ميزات (التعليقات بالصينية)
أيضا هناك مكون AExport الذي يستخدم AExcel فيه بعض الأخطاء
مثال آخر مشابه هنا:
![[-]](https://delphi4arab.net/forum/D4A2020/collapse.png)
