ana detay tablolarımı excel e aktarmak istiyordum..
delphiturkiye forumlarından bulduğum konu geliştirerek bunu yaptım..
örnek procedure ihitaç olur düşüncesiyle kodu size yazmayı düşündüm...
Kod: Tümünü seç
procedure ExcelAt2(Qry, qry2, qry3: TDataset);
var
Excel :variant;
satir,sutun,i,j,k :integer;
Str,str2,str3 :String;
begin
Excel := CreateOleObject('excel.application');
Excel.visible := true;
Excel.workbooks.add;
satir:=1;
sutun:=1;
Excel.columns[1].columnwidth:=40;
Excel.columns[2].columnwidth:=12;
Excel.columns[3].columnwidth:=12;
Excel.columns[4].columnwidth:=15;
Excel.columns[5].columnwidth:=15;
Excel.columns[6].columnwidth:=10;
Excel.columns[7].columnwidth:=20;
Excel.columns[8].columnwidth:=10;
Excel.columns[9].columnwidth:=10;
Excel.columns[10].columnwidth:=10;
Excel.columns[11].columnwidth:=10;
Excel.columns[12].columnwidth:=10;
Excel.columns[13].columnwidth:=20;
try
if not Qry.IsEmpty then
begin
Qry.First;
while not Qry.Eof do
begin
satir:=satir+1;
str:='İlçe Adı....:';
sutun:=1;
//ben ilk iki alanı almak istemiyorum..o nedenle 2 den başlıyor...
for i := 2 to Qry.FieldCount - 1 do
begin
str :=str+Qry.Fields[i].AsString;
Excel.cells[satir,sutun].value:=str;
excel.rows[satir].font.Color :=clblue;
excel.rows[satir].font.size :=20;
sutun:=sutun+1;
str:='';
end;
satir:=satir+1;
if not Qry2.IsEmpty then
begin
sutun:=1;
Qry2.First;
while not Qry2.Eof do
begin
str2:='Okul Adı...:';
sutun:=1;
for j := 2 to Qry2.FieldCount - 1 do
begin
str2 := str2+ Qry2.Fields[j].AsString;
Excel.cells[satir,sutun].value:=str2;
excel.rows[satir].font.Color :=clgreen;
excel.rows[satir].font.size :=16;
sutun:=sutun+1;
str2:='';
end;
satir:=satir+1;
Excel.ActiveSheet.rows[satir].Insert;
excel.rows[satir].font.Color :=clblack;
excel.rows[satir].font.size :=10;
Excel.cells[satir,2].value:='Branşı Görev';
Excel.cells[satir,3].value:='TC Kimlik No';
Excel.cells[satir,4].value:='Adı Soyadı';
Excel.cells[satir,5].value:='Doğum Yeri veYılı';
Excel.cells[satir,6].value:='Arşiv No';
Excel.cells[satir,7].value:='Mezun Olduğu Okul';
Excel.cells[satir,8].value:='İlk Göreve Başlama Tarihi';
Excel.cells[satir,9].value:='Atama İnhasının Tarih ve Sayısı';
Excel.cells[satir,10].value:='Geldiği yer';
Excel.cells[satir,11].value:='Bu Okulda Göreve Başlama Tarihi';
Excel.cells[satir,12].value:='Ayrılma Tarihi';
Excel.cells[satir,13].value:='Gittiği Yer';
Excel.cells[satir,14].value:='Açıklama';
satir:=satir+1;
if not Qry3.IsEmpty then
begin
str3 := '';
Qry3.First;
while not Qry3.Eof do
begin
sutun:=1;
for k := 2 to Qry3.FieldCount - 1 do
begin
str3 := Qry3.Fields[k].AsString;
Excel.cells[satir,sutun+1].value:=str3;
excel.rows[satir].font.size :=8;
if Qry3.FieldByName('Renk').AsString='k' then
begin
excel.rows[satir].font.Color :=clred;
end
else
excel.rows[satir].font.Color :=clblack;
sutun:=sutun+1;
end;
satir:=satir+1;
Qry3.Next;
end;
end;
qry2.Next;
end;
end;
qry.Next;
end;
end;
finally
Excel.visible := true;
end;
end;
Kod: Tümünü seç
procedure Tdisaaktar.cxButton1Click(Sender: TObject);
begin
excelat2(vt.ilceler, vt.okullar, vt.personel);
end;
NOT: Kodlarımızı
Kod: Tümünü seç
tagı içerisinie alalım.
Makaleler kısmına taşındı.(aslangeri)[/size][/color]