Excele aktarma

[sako]

Kod: Tümünü seç

var Book : Variant;
    FileName : String;
    Excel,Sheet : Variant;
    i:integer;
begin
 Excel := CreateOleObject('Excel.Application');
 repeat
FileName := Excel.GetOpenFileName;

until  FileName <> '0';
 Book := Excel.WorkBooks.Open(FileName);
 Excel.Visible := False;
 Sheet := Book.Worksheets[1];

 for i:=1 to 15 do begin
 Sheet.Cells[i,1]:=table1.FieldByName('stok_no').AsString;
 Sheet.Cells[i,2]:=table1.FieldByName('malzemeadi').AsString;
 table1.Next;
end;

Yularıdaki kodla veritabanındaki 15 kaydı excelin ilk satırından başlayarak gönderiyoeum. Yapmak istediğim şu aslında bu kayıtları 15 erli gruplar halinde excele aktarmak. Yani ilk 15 ten sonra 1 boşluk sonra ikinci 15 , üçüncü 15 ...... son kayda kadar. Repeat until ile olur dedim ama yapamadım ....

[emin_as]

Kod: Tümünü seç

i:=1;
z:=0;
while not table1.eof do
begin
  Sheet.Cells[i,1]:=table1.FieldByName('stok_no').AsString; 
  Sheet.Cells[i,2]:=table1.FieldByName('malzemeadi').AsString;
  inc(i);
  inc(z);
  if (z = 15) then 
  begin
    inc(i);
    z:=0;
  end;
  table1.Next;
end;

Bu kod işini görür.

[ikutluay]

Kod: Tümünü seç

i:=1;
z:=0;
while not table1.eof do
begin
  Sheet.Cells[i,1]:=table1.FieldByName('stok_no').AsString; 
  Sheet.Cells[i,2]:=table1.FieldByName('malzemeadi').AsString;
  inc(i);
  inc(z);
  if (z = 15) then 
  begin
    inc(i);
    z:=0;
  end;
  table1.Next;
end;

Bu kod işini görür.

bu kodla her hücre tek tek ihrac edileceğinden kod çok yavaş çalışır. sanırım arkadaşın istediği 15 satırı aynı anda atmak. daha önce verdimmi bilmiyorum ama aşağıda askerde yazdığım bir kod var.

kod 11 kolonluk bir belgeye 20 satırı bir anda atıyor. mantığı ise hafızada bir variant dizi oluşturup bu diziyi doldurmak ve bu dizinin tüm lemanlarını bir anda export etmek. haliyle işlem eskisine nazaran ışık hızında bitiyor.

açıklama satırları haline getirdiğim kısım bunu yapıyor. ama kayıtların 15 ile tam bolunan sayıda olmadığı durumda kod son blogu atmyacaktır. bu yuzden satır satır (ama komple satır olarak atan kod şu an açık durumda. ) basit bir kontrolle son bloguda atan kodu yazabilrsiniz. MOD fonksiyonu işe yarayacaktır. son döngü için. burada fazlalıkları ayıklamak size kalmış. ve program varsayılan olarak varolan bir excel belgesine export ediyor. siz isterseniz bu belgeyi istediğiniz gibi düzenleyin isterseniz boş bir dosya a.çtırın size kalmış. Bendeki excel formu 20 satırılık ve 11 kolonluk idi. aradaki boşluk sayılarıda sabitlenmişti. bunuda atlıyordu kodumuz.

Kod: Tümünü seç

Procedure TFrmMaas.BtnexcelformClick(Sender : TObject);
Var
  satno,sat, sut, sno,i,j : Integer;
  A: Variant;


Begin
  satno := 0;
  Sno := 0;
    If not FileExists(formpath+'Frmbordro.Xls') then
      Frmdp.Depo.IkFindAndExtract('frmbordro.xls',formpath+'Frmbordro.Xls');

  If IkOpenExcel(True) Then
   If Not Ikloadform(formpath + 'frmbordro.xls', 1) = 1 Then
      Exit;
  Dmodule.Tblmaas.DisableControls;
  Dmodule.TblMaas.IndexName := 'idxmaas';
  Dmodule.Tblmaas.First;
  Sat := 7;
//  A :=VarArrayCreate([1, 20, 1,11], varVariant);
  A :=VarArrayCreate([1, 1, 1,11], varVariant);
  While Not Dmodule.Tblmaas.EOF Do
   Begin
    Inc(sno);  Inc(satno);  inc(sat);
    a[satno,01]:=IntToStr(Sno);
    a[satno,02]:=Ikstrutils.UpperStrTr(Dmodule.TblMaasmtertip.AsString);
    a[satno,03]:=Ikstrutils.UpperStrTr(Dmodule.TblMaasmrutbe.AsString);
    a[satno,04]:=Ikstrutils.UpperStrTr(Dmodule.TblMaasmbaba.AsString);
    a[satno,05]:=Ikstrutils.UpperStrTr(Dmodule.TblMaasmadi.AsString + ' ' +Dmodule.TblMaasmsoyadi.AsString);
    a[satno,06]:=Ikstrutils.UpperStrTr(Dmodule.TblMaasmsube.AsString);
    a[satno,07]:='';
    a[satno,08]:='';
    a[satno,09]:=IntToStr(Dmodule.TblMaasmaasi.Value);
    a[satno,10]:='';
    a[satno,11]:=Dmodule.Tblmaasmaciklama.AsString;
//    memohata.Lines.Add(IntToStr(Sno)+' '+IntToStr(sat)+' '+IntToStr(Satno)+' '+Dmodule.TblMaasmadi.AsString + ' ' +Dmodule.TblMaasmsoyadi.AsString);
           // VarArrayCreate()
{    IkWriteCell(sat, 1, IntToStr(Sno), True);
    IkWriteCell(sat, 2, Dmodule.TblMaasmtertip.AsString, True);
    IkWriteCell(sat, 3, Dmodule.TblMaasmrutbe.AsString, True);
    IkWriteCell(sat, 4, Dmodule.TblMaasmbaba.AsString, True);
    IkWriteCell(sat, 5, Dmodule.TblMaasmadi.AsString + ' ' +
      Dmodule.TblMaasmsoyadi.AsString, True);
    IkWriteCell(sat, 6, Dmodule.TblMaasmsube.AsString, True);
    IkWriteCell(sat, 9, IntToStr(Dmodule.TblMaasmaasi.Value), True);
    IKWriteCell(sat, 11, Dmodule.Tblmaasmaciklama.AsString, True);}
//    If (sno Mod 20 = 0) Then
//     begin
//      ExRange := ExWorkBook.WorkSheets[1].Range[ExWorkBook.WorkSheets[1].Cells[sat-20, 1],
//                   ExWorkBook.WorkSheets[1].Cells[Sat-1, 11]];
      ExRange := ExWorkBook.WorkSheets[1].Range[ExWorkBook.WorkSheets[1].Cells[sat, 1],
                   ExWorkBook.WorkSheets[1].Cells[Sat, 11]];

      Exrange.Value:=A;
      If Sno Mod 20 = 0 then Sat := sat + 8;
      satno:=0;
//      for i:=1 to 20 do
        for j:=1 to 11 do
          A[1,j]:='';
//     End;
    Dmodule.Tblmaas.Next;
   End;
//    If (sno Mod 20 <> 0) Then
//     begin
//      Sat := sat + 8;
//      ExRange := ExWorkBook.WorkSheets[1].Range[ExWorkBook.WorkSheets[1].Cells[sat-20, 1],
//                   ExWorkBook.WorkSheets[1].Cells[Sat-1, 11]];
//      Exrange.Value:=A;

//      satno:=0;
//     End;
//  ikExcell.ExExcel.FileSaveas('c:\deneme');
  Dmodule.Tblmaas.EnableControls;
End;

umarım işe yarar. (Not ole kodlarının denemesi için ide dışında olması tavsiye edilir (halihazırda açık olan exceli kullan derseniz). ik wirte cell ise küçük bir kod . tek yaptığı satır sütuna veriyi atmak.

[sako]

Kod: Tümünü seç

i:=1;
z:=0;
while not table1.eof do
begin
  Sheet.Cells[i,1]:=table1.FieldByName('stok_no').AsString; 
  Sheet.Cells[i,2]:=table1.FieldByName('malzemeadi').AsString;
  inc(i);
  inc(z);
  if (z = 15) then 
  begin
    inc(i);
    z:=0;
  end;
  table1.Next;
end;

Bu kod işini görür.

İşimi gördü Teşekkürler