excel aktarma

[erdogan_ozkaya]

merhaba arkadaşlar
bir kod ile tableyi excel aktarıyorum fakat aktardığım kayılar excelde biçimsiz olarak çıkıyor
sorum şu alttaki koda nasıl bir kod eklemeliyimki excel aktardığımda ordaki hücereleri biçimlendirebileyim renklendirebileyim
cevanız için şimdiden teşekkür ederim
örnek yapmak istediğim
http://www.amatisyazilim.com/images/Ayl ... _excel.jpg

aşağıdaki kodun yaptığı
http://www.nasill.com/images/0/09/Excel2SQL4.jpg

Not : Resimler Örnektir

Kod: Tümünü seç

var
    v,sayfa:variant;{v excel prg, sayfa calisma sayfasi}
    i,d,k:integer;
    r:variant;
begin
    if (ADOQuery1.RecordCount=0)
    then showmessage('                 Aktarılacak Bir Kayıt Yoktur                 ') else
    begin
    ADOQuery1.First;  
    v:=CreateOleObject('excel.application');
    v.workbooks.add;
    sayfa:=v.workbooks[1].worksheets[1];
    r:=v.activeworkbook.worksheets[1].cells[1];
 
    k:=0;
    repeat
    r.cells[1,k+1]:=ADOQuery1.Fields[k].DisplayLabel;
    k:=k+1;
    until k=ADOQuery1.Fields.Count;
 
    i:=0;
    d:=0;
    while Not ADOQuery1.eof do
   begin
   i:=i+1;
   d:=d+1;                                                 
   r.cells[1+d,i]:=ADOQuery1.FieldByName('grup').AsString;
   r.cells[1+d,i+1]:=ADOQuery1.FieldByName('Soru').AsString;
   r.cells[1+d,i+2]:=ADOQuery1.FieldByName('Cevap').AsString;
   r.cells[1+d,i+3]:=ADOQuery1.FieldByName('Puan').AsString;
   r.cells[1+d,i+4]:=ADOQuery1.FieldByName('Sure').AsString;
   r.cells[1+d,i+5]:=ADOQuery1.FieldByName('(A)').AsString;
   r.cells[1+d,i+6]:=ADOQuery1.FieldByName('(B)').AsString;
   r.cells[1+d,i+7]:=ADOQuery1.FieldByName('(C)').AsString;
   r.cells[1+d,i+8]:=ADOQuery1.FieldByName('(D)').AsString;
   r.cells[1+d,i+9]:=ADOQuery1.FieldByName('Dogru_Sik').AsString;
   ADOQuery1.Next;
   i:=0;
   end;
   v.visible:=true;
   ShowMessage( '             '+inttostr(ADOQuery1.RecordCount)+ ' = Kayıt Excel,e Başarı İle Aktarıldı             ');
   end;
end;

[conari]

Hiç arama yapmıyorsun sanırım.

Kod: Tümünü seç

          excel.range['D1:K100'].NumberFormat := '#.##,00';
          excel.range['A1:K1'].Font.Color      := CLRED;
          excel.range['A1:K1'].Font.Bold       := True;
          excel.range['A1','K100'].EntireColumn.AutoFit;
          excel.range['A2'].select;
          excel.ActiveWindow.FreezePanes  := True ;

[erdogan_ozkaya]

ya inan en son yazıyorum artık bulamassam yazıyorum

[erdogan_ozkaya]

biliyorum yine kızcan ama ya acemiliğimize ver yeni yeni öğreniyorum inan
verdiğin kodda hata veriyor

[conari]

benim verdiği kod size aynen uymaz ki.

Hatayı da yazmıyorsun.

V.range['A1:K1'].Font.Color := CLRED;

şeklinde kullanman lazım.

[erdogan_ozkaya]

böyle yazıyorum ama eskisi gibi yapıyor kodu hangi satıra koymalıyımki

Kod: Tümünü seç

procedure Tsinav_sonuclari.SonularExcellAktar1Click(Sender: TObject);
var
    v,sayfa:variant;{v excel prg, sayfa calisma sayfasi}
    i,d,k:integer;
    r:variant;
begin
    if (ADOQuery1.RecordCount=0)
    then showmessage('                 Aktarılacak Bir Kayıt Yoktur                 ') else
    begin
    ADOQuery1.First;  
    v:=CreateOleObject('excel.application');
    v.workbooks.add;
    sayfa:=v.workbooks[1].worksheets[1];{Birinci calisma sayfasini sayfa degiskenine ata}
    r:=v.activeworkbook.worksheets[1].cells[1];
////////////////////////////////////////////////////

               v.range['D1:K100'].NumberFormat := '#.##,00';
          v.range['A1:K1'].Font.Color      := CLRED;
          v.range['A1:K1'].Font.Bold       := True;
          v.range['A1','K100'].EntireColumn.AutoFit;
          v.range['A2'].select;
          v.ActiveWindow.FreezePanes  := True ;
/////////////////////////////////////////////////////////////
 
    k:=0;
    repeat
    r.cells[1,k+1]:=ADOQuery1.Fields[k].DisplayLabel;//Başlıkları Yazıyor
    k:=k+1;
    until k=ADOQuery1.Fields.Count;
 
    i:=0;
    d:=0;
    while Not ADOQuery1.eof do
begin
    i:=i+1;
    d:=d+1;                                                 
    r.cells[1+d,i]:=ADOQuery1.FieldByName('grup').AsString;
    r.cells[1+d,i+1]:=ADOQuery1.FieldByName('Soru').AsString;
    r.cells[1+d,i+2]:=ADOQuery1.FieldByName('Cevap').AsString;
    r.cells[1+d,i+3]:=ADOQuery1.FieldByName('Puan').AsString;
    r.cells[1+d,i+4]:=ADOQuery1.FieldByName('Sure').AsString;
    r.cells[1+d,i+5]:=ADOQuery1.FieldByName('(A)').AsString;
    r.cells[1+d,i+6]:=ADOQuery1.FieldByName('(B)').AsString;
 r.cells[1+d,i+7]:=ADOQuery1.FieldByName('(C)').AsString;
 r.cells[1+d,i+8]:=ADOQuery1.FieldByName('(D)').AsString;
 r.cells[1+d,i+9]:=ADOQuery1.FieldByName('Dogru_Sik').AsString;
     ADOQuery1.Next;
    i:=0;
 end;
    v.visible:=true;
 ShowMessage( '             '+inttostr(ADOQuery1.RecordCount)+ ' = Kayıt Excel,e Başarı İle Aktarıldı             ');
       end;
end;

[conari]

R olarak değiştirip denermisin.

[erdogan_ozkaya]

hocam denedim ama hata verdi bu satırda

Kod: Tümünü seç

 r.ActiveWindow.FreezePanes  := True ;

[conari]

Hataları yazmak bu kadar zormu yoksa sanamı zor geliyor?
onu kaldırıp dene.
birde biçimlendirmeyi veriyi yazdıktan sonra yap.

[erdogan_ozkaya]

Hocam verdiğiniz kod için teşekkür ederim çalışıyor problemsiz
yine ufak bir sorum olacak excellde ki zemin rengini veremedim bir türlü
var
v,sayfa:variant;
i,d,k:integer;
r:variant;
begin
ADOTable1.First;
v:=createoleobject('excel.application');
v.workbooks.add;
v.range['D1:K100'].NumberFormat := '#.##,00 TL';

v.range['A1:K1'].Font.Color := CLRED;
v.range['A1:K1'].Font.Size :='13';
v.range['A1:K1'].Color :=clblue;
v.range['A1:K1'].Font.Bold := True;
v.range['A1','K100'].EntireColumn.AutoFit;
v.range['A2'].select;
v.ActiveWindow.FreezePanes := True ;
sayfa:=v.workbooks[1].worksheets[1];
r:=v.activeworkbook.worksheets[1].cells[1];

k:=0;
repeat
r.cells[1,k+1]:=ADOTable1.Fields[k].DisplayLabel;//Başlıkları Yazıyor
k:=k+1;
until k=ADOTable1.Fields.Count;

i:=0;
d:=0;
while Not ADOTable1.eof do
begin
i:=i+1;
d:=d+1;
r.cells[1+d,i]:=ADOTable1.FieldByName('Soru').AsString;
r.cells[1+d,i+1]:=ADOTable1.FieldByName('Cevap').AsString;
ADOTable1.Next;
i:=0;
end;
v.visible:=true;
end;

[conari]

Kod: Tümünü seç

var
  RangeM: Variant;
begin
   RangeM := v.Range['A1:K100']; //Değişkene hücre aralığını ata.
   RangeM.Columns.Interior.ColorIndex := 3; //A1 ile K100 arasındaki hücrelerin rengini değiştir    

[erdogan_ozkaya]

teşekkür ederim saol