Excele aktarma

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
sako
Üye
Mesajlar: 477
Kayıt: 11 Haz 2003 02:40
Konum: ERZURUM

Excele aktarma

Mesaj gönderen sako »

Aşağıdaki kodla excele aktarıyorum sıkıntı yok.

v:=createoleobject('excel.application');
v.workbooks.add;
sayfa:=v.workbooks[1].worksheets[1];
r:=v.activeworkbook.worksheets[1].cells[1];
i:=0;
d:=0;
IBQuery1.FetchAll;
IBQuery1.First;

while Not IBQuery1.eof do
begin
i:=i+1;
d:=d+1;
r.cells[1,1]:='TARİH';
r.cells[1,2]:='SAYI';
r.cells[1,3]:='DOSYA DURUMU';
r.cells[1+d,i]:=IBQuery1.FieldByName('TARIH').AsString;
r.cells[1+d,i+1]:=IBQuery1.FieldByName('SAYI').AsString;
r.cells[1+d,i+2]:=IBQuery1.FieldByName('dosyadurum').AsString;
ibquery1.next;
end;
v.visible:=true;
end;

Ama şöyle bir şey yapmam gerekiyor bir türlü döngüyü kuramadım.

query de kayda bakacak o dosya numarasından başka bir tabloda kayıt varsa mesela 20 tane buldu diyelim onları o dosyanın altına excelde alt alta sıralayacak, sonra diğer kayıt ... Aşağıdaki gibi bir tablo dökümü yapmam lazım. Alta kod ekledim olmadı üste ekledim olmadı.
Normalde query den kayıt numarasına göre bir tablenin mastersource özelliğiyle detayları alıyorum ama her kaydın altına bunları ekleyemiyorum.

Resim
En son sako tarafından 18 Nis 2014 03:42 tarihinde düzenlendi, toplamda 1 kere düzenlendi.
DOĞUNUN SINIR TAŞI ERZURUM'UN DADAŞ'I
EFE'Sİ VAR İZMİR'İN EĞİLMEZ TÜRK' ÜN BAŞI
Lord_Ares
Üye
Mesajlar: 1070
Kayıt: 15 Eki 2006 04:33
Konum: Çorlu

Re: Excele aktarma

Mesaj gönderen Lord_Ares »

query ile çoklu tablo sorgulayıp çıkan sonuçları order by ile koduna göre düzenle sonra excele atarsan istediğin olur. Çoklu tablo sorgulama diye formda aratırsan örnek kodlar bulabilirsin. ikinci bir seçenek delphi ile exceli koduna göre filtreleyebilirsen aynı koda sahip olanlar alt alta gelecektir.
Kolay gelsin
xxxjedixxx
Üye
Mesajlar: 216
Kayıt: 10 Ara 2013 03:50

Re: Excele aktarma

Mesaj gönderen xxxjedixxx »

Tarih, Sayı ve Dosya Durumu metinlerini sürekli olarak yazıyorsun. Bu kısım döngü dışında olmalı.
Öncelikle sorgunun sonuna "Order by tarih, sayi, dosyadurum" ekle.

Kod: Tümünü seç

var
  eTarih,  eSayi, eDurum: string;
...
Sayfa.cells[1,1] := 'TARİH';
Sayfa.cells[1,2] := 'SAYI';
Sayfa.cells[1,3] := 'DOSYA DURUMU';
Sayfa.cells[1,4] := 'DETAY';
eTarih := ''; eSayi := ''; eDurum := '';
d := 1; // döngüde 2. den başlaması için

while Not IBQuery1.eof do
begin
  inc(d);
  if (eTarih <> IBQuery1.FieldByName('TARIH').AsString) or (eSayi <> IBQuery1.FieldByName('SAYI').AsString) or 
     (eDurum <> IBQuery1.FieldByName('dosyadurum').AsString) then
  begin
    eTarih := IBQuery1.FieldByName('TARIH').AsString);
    eSayi := IBQuery1.FieldByName('SAYI').AsString);
    eDurum := IBQuery1.FieldByName('dosyadurum').AsString;
    Sayfa.cells[d, 1] := eTarih; 
    Sayfa.cells[d, 2] := eSayi;
    Sayfa.cells[d, 3] := eDurum;
    i := 1; // eğer aynı satıra yazdıracaksan 0 yap
  end;  
  Sayfa.cells[d + i, 4] := IBQuery1.FieldByName('detay').AsString;
  ibquery1.next;
end;
...
sako
Üye
Mesajlar: 477
Kayıt: 11 Haz 2003 02:40
Konum: ERZURUM

Re: Excele aktarma

Mesaj gönderen sako »

Teşekkürler akadaşlar sorunu hallettim.
Resmdeki gibi her dosyayı alt alta deilde her dosyaya açık olan excel dosyasında bir sayfa açmak istersem bilgisayarı kasarmıyım sizce.Exceli bir kere açsam ondan sonraki sorgularımı da açık olan bu excel soyasındaki oluşturacağım sayfaya atsam fazla da kasmaz diye düşünüyorum. Ama aktif excel dosyasına veri ve sayfa eklemeyi bilmiyorum.

v:=createOleObject('excel.application'); exceli yeniden oluşturuyor. bir kere bu şekilde dosyayı açtım diyelim sonrasında bu dosyaya sayfa ekleyip sorgularımı nasıl ekleyebilitim?
DOĞUNUN SINIR TAŞI ERZURUM'UN DADAŞ'I
EFE'Sİ VAR İZMİR'İN EĞİLMEZ TÜRK' ÜN BAŞI
Lord_Ares
Üye
Mesajlar: 1070
Kayıt: 15 Eki 2006 04:33
Konum: Çorlu

Re: Excele aktarma

Mesaj gönderen Lord_Ares »

Excel ile yapabileceğin bazı şeylerin kodlarını aşağıda veriyorum. İncelersin , aradığın hepsi var.

Kod: Tümünü seç



uses comobj,xlconst; //comobj kütüphanesinin eklenmesi gerekiyor

Kod:


// excel dosyasının açılması ve işlem için hazırlanması ile ilgi procedure
procedure tform1.dosyaac;
begin
  // Excel oluşturuluyor
  ExcelApp := CreateOleObject('Excel.Application');
  try
    ExcelApp.Workbooks.Open('C:\deneme.xls');
    // deneme.xls dosyası işlem için açılıyor
  finally
    // Excel dosyası kapatılıyor.
    if not VarIsEmpty(ExcelApp) then
    begin
        ExcelApp.DisplayAlerts := False;  //Excel mesajlarını görünteleme
        ExcelApp.Quit;
        ExcelApp := Unassigned;
    end;
  end;
end;



//Hucre duzenleme ile ilgi procedure
Kod:

procedure TForm1.HucreDuzenle;
var
  Range: Variant;
begin
  //Sayfa1 deki C1 ile F25 arasını seç
  Range := XLApp.Workbooks[1].WorkSheets['Sayfa1'].Range['C1:F25'];
  //Sayfa1 deki C1 ile F25 arasındaki hücrelere RAND() formülü yerleştir.
  Range.Formula := '=RAND()';
  //Sayfa1 deki C1 ile F25 arasındaki hücrelerin rengini değiştir
  Range.Columns.Interior.ColorIndex := 3;
  Range.Borders.LineStyle := xlContinuous;
end;



// Kolon düzenleme ile ilgili procedure
Kod:

procedure TForm1.ChangeColumns;
var
  ColumnRange: Variant;
begin
  ColumnRange := XLApp.Workbooks[1].WorkSheets['Sayfa1'].Columns;
  //1 nolu kolonun genişliği 5 olarak ayarlandı.
  ColumnRange.Columns[1].ColumnWidth := 5;
  //1 nolu kolonun fontu koyu olarak ayarlandı.
  ColumnRange.Columns[1].Font.Bold := True;
  //1 nolu kolonun font rengi mavi olarak ayarlandı.
  ColumnRange.Columns[1].Font.Color := clBlue;
end;



//Grafik nesnesi eklemek için ilgili procedure
Kod:

procedure TForm1.ChartData;
var
  ARange: Variant;
  Sheets: Variant;
begin
  XLApp.Workbooks[1].Sheets.Add(,,1,xlChart);
  Sheets := XLApp.Sheets;
  ARange := Sheets.Item['Sayfa1'].Range['A1:A10'];
  Sheets.Item['Chart1'].SeriesCollection.Item[1].Values := ARange;
  Sheets.Item['Chart1'].ChartType := xl3DPie;
  Sheets.Item['Chart1'].SeriesCollection.Item[1].HasDataLabels := True;

  XLApp.Workbooks[1].Sheets.Add(,,1,xlChart);
  Sheets.Item['Chart2'].SeriesCollection.Item[1].Values := ARange;
  Sheets.Item['Chart2'].SeriesCollection.Add(ARange);
  Sheets.Item['Chart2'].SeriesCollection.NewSeries;
  Sheets.Item['Chart2'].SeriesCollection.Item[3].Values :=
    VarArrayOf([1,2,3,4,5, 6,7,8,9,10]);
  Sheets.Item['Chart2'].ChartType := xl3DColumn;
end;



//Excel deki aktif sayfayı Text dosya olarak kaydetmek
Kod:

function ExcelSaveAsText(ExcelFile, TextFile: TFileName): Boolean;
const
  xlText = -4158;
var
  ExcelApp: OleVariant;
  vTemp1, vTemp2, vTemp3: OLEVariant;
begin
  Result := False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    // Hata olursa çıkış
    Exit;
  end;
  try
    //Excel dosyasını aç
    ExcelApp.Workbooks.Open(ExcelFile);
    ExcelApp.DisplayAlerts := False;
    vTemp3 := False;
    vTemp2 := xlText;
    vTemp1 := TextFile;
    //Açılan excel dosyasını text olarak kaydet
    ExcelApp.ActiveWorkbook.SaveAs(vTemp1, vTemp2, vTemp3);
    Result := True;
  finally
    //Excel kapat ve çık
    ExcelApp.Quit;
    ExcelApp := Unassigned;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //Üstteki fonksiyonun kullanım şekli
  ExcelSaveAsText('C:\deneme.xls','C:\denemetext.txt');
end;



//Excel de satırlarda kelime arama
Kod:

ExcelRow := ExcelSheet.Cells.Find(What:='abc').Row;


//Belli bir hücreye text yazmak için
Kod:

SHEET.CELLS[1,1]:= 'DENEME METİN'; {SATIR,SÜTUN}



//Hücrenin font u ile ilgili işlemler için
Kod:

SHEET.CELLS[1,1].Font.Color     := $00E88017;
SHEET.CELLS[1,1].Font.Bold      := True;
SHEET.CELLS[1,1].Font.italic    := True;
SHEET.CELLS[1,1].Font.Underline := true;
SHEET.CELLS[1,1].Font.Size      := 20;



//Hücre içindeki bir aralıktaki metin ile ilgilli işlem için
Kod:

SHEET.CELLS[1,1].Characters(3, 1).Font.Bold := True;



//Aralıktaki bütün hücrelerin dört kenarını renklendirir
Kod:

SHEET.RANGE['A1:A10'].Borders.Color := $00E88017;



//Bir tek hücrenin çerçevesine müdahale
Kod:

SHEET.CELLS[1,10].Borders.LineStyle := xlContinuous;



//Aralıktaki hücrelere çerçevesine müdahale
Kod:

SHEET.RANGE['A1:A10'].Borders.LineStyle := xlContinuous;



//Belirlenen kolonu silmek için
Kod:

Excel.ActiveSheet.columns[2].delete;



//Otomatik kolon genişliği için
Kod:

excel.range['A1','L10'].EntireColumn.AutoFit;



// Sayfa ismi değiştir
Kod:

  ExcelApp.Workbooks[1].WorkSheets[1].Name := 'Yeni isim';




//Hücreyi tah formatına göre düzenleme ve yazdırma
Kod:

  ExcelApp.Cells[3, 1].Value := FormatDateTime('dd-mmm-yyyy', Now);



//Türkçe yada ing. excel kullanıyorsanız farkezme.
// Hücrede TOPLAM yazdırıcaksanız bu formülü kullanın
Kod:

ExcelApp.Range['A11', 'A11'].Formula := '=Sum(A1:A10)';



//Hücreyi sağa döşe
Kod:

  ExcelApp.Cells[2, 1].HorizontalAlignment :=-4152;


//Hücreyi sola döşe
Kod:

  ExcelApp.Cells[2, 1].HorizontalAlignment :=-4131;


//Hücreyi Yukarı döşe
Kod:

  ExcelApp.Cells[2, 1].HorizontalAlignment :=-4160;


//Hücreyi aşağı döşe
Kod:

  ExcelApp.Cells[2, 1].HorizontalAlignment :=-4107;


//Aralıktaki hücreleri koyu yap
Kod:

  ExcelApp.Range['B16:M26'].Font.Bold := True;



// Aralıktaki hücrelerin font ölçüsünü 12 yap
Kod:

  ExcelApp.Range['B16:M26'].Font.Size := 12;



//Aktif excel sayfasının yazıcı sayfasını yatay yap
Kod:

ExcelApp.ActiveSheet.PageSetup.Orientation :=2;



//Aktif excel sayfasının yazıcı sayfasını dikey yap
Kod:

ExcelApp.ActiveSheet.PageSetup.Orientation :=1;



//Aktif excel sayfasının yazıcı kağıt boşlukları
Kod:

  ExcelApp.ActiveSheet.PageSetup.LeftMargin  := 35;
  ExcelApp.ActiveSheet.PageSetup.RightMargin := -15;



//Aktif excel sayfasının yazım ölçüsünü %95 küçült
Kod:

ExcelApp.ActiveSheet.PageSetup.Zoom := 95;



// Aktif excel sayfasının yazıcı kağıdını A4 seçer
Kod:

  ExcelApp.PageSetup.PaperSize := 9;



// Çizgileri göster ve gösterme
Kod:

  ExcelApp.ActiveWindow.DisplayGridlines := False;



// Siyah ve Beyaz olarak ayarla
Kod:

  ExcelApp.ActiveSheet.PageSetup.BlackAndWhite := False;



//Excel versiyonunu öğrenmek için
Kod:

  ShowMessage(Format('Excel Version %s: ', [ExcelApp.Version]));



//Program çalışırken açılan excel dosyasını göster
Kod:

  ExcelApp.Visible := True;



//Excel dosyasını kaydet
Kod:

  ExcelApp.SaveAs('c:\deneme.xls');



//Aktif excel kitabını kaydet
Kod:

  ExcelApp.ActiveWorkBook.SaveAs('c:\filename.xls');



//Excel içindeki başka bir sayfayı seçmek için
Kod:

   excel.Sheets['Sayfa2'].Select;



//Excel dosyasında kaç tane sayfa var
Kod:

kacsayfa:=excel.Workbooks[1].Sheets.Count;



//Excel dosyası içinde Sayfa5 varmı
Kod:

for i:=1 to excel.Workbooks[1].Sheets.Count do
   if Excel.Workbooks[1].WorkSheets[i].Name='Sayfa5' then varmi:=true;



//Yeni sayfa ekle ve isim ver
Kod:

excel.Sheets.Add;
Excel.ActiveSheet.Name :='Yeni Sayfa';



//Sayfa1 den Sayfa2 Belli hücre aralığını kopyala
Kod:

   excel.Sheets['Sayfa1'].Select;
  DestRange := Excel.Range['A1','D10'];
  Excel.Range['A1','D10'].Copy(EmptyParam);
   excel.Sheets['Sayfa2'].Select;
  excel.Range['A1','D10'].Select;
  excel.activesheet.paste;



//1. kolona göre dolu olan son satırı tespit etmek için excelsonsatir(1);
Kod:

function excelsonsatir(AColumn: Integer): Integer;
const
  xlUp = 3;
begin
    Result := excel.Range[Char(96 + AColumn) + IntToStr(65536)].end[xlUp].Rows.Row;
end;



//hücre ekle aşağı kaydır
Kod:

excel.Cells.Item[2,2].Insert(xlShiftDown);


//satır ekle aşağı kaydır
Kod:

excel.Cells.Item[2,2].EntireRow.Insert(xlShiftDown);


//hücre sil sola kaydır
Kod:

excel.Cells.Item[2,2].Delete(xlShiftToLeft);


//Bunun ne olduğunu bilmiyorum
Kod:

excel.Cells.Item[2,2].EntireColumn.Delete(xlShiftToLeft);



//satır ı otomatik yüksekliğini ayarla
Kod:

excel.Range['A1','C10'].Rows.Autofit;



//bulunan satırı silmek için
Kod:

Excel.rows[i].delete;


// bir aralıktaki satırları silmek için
Kod:

MsExcelWorkSheet1.ActiveSheet.Rows[IntToStr(StartRow)+':'+IntToStr(EndRow)].Select;
MsExcelWorkSheet1.ActiveSheet.Rows[IntToStr(StartRow)+':'+IntToStr(EndRow)].Delete;


//satır yüksekliği ayarla
Kod:

Excel.ActiveSheet.Rows[2].RowHeight := 1/0.035;


//Çerçevenin kalınlığını ayarlamak için 1-2-3-4-5-6 kenarları
Kod:

ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;


//Hücredeki açıklamaları siler.
Kod:

ExcelApp.ActiveSheet.Cells[1,4].ClearContents;



//Hücrenin isim font ve renk özelliklerini ayarlamak için
Kod:

ExcelApp.ActiveSheet.Rows[1].Font.Name := 'Arial Tur';
ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;


//Yazıcı çıktısında başlık bilgilerini düzenlenmesi
Kod:

ExcelApp.ActiveSheet.PageSetup.CenterHeader := '????';
ExcelApp.ActiveSheet.PageSetup.CenterFooter := '?&P?';



//Yazıcı çıktısında sayfa özelliklerinin ayarlanması
Kod:

//2cm
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
//3cm
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
//2cm
ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
//gridlines
ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;



//Bir kopyalama yöntemi
Kod:

ExcelApp.ActiveSheet.Used.Range.Copy;
ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
ExcelApp.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
ExcelApp.ActiveSheet.Range.PasteSpecial;



//satır ekle
Kod:

ExcelApp.ActiveSheet.Rows[2].Insert;



//kolon ekle
Kod:

ExcelApp.ActiveSheet.Columns[1].Insert;




//satır sil
Kod:

ExcelApp.ActiveSheet.Rows[2].Delete;



//Kolon sil
Kod:

ExcelApp.ActiveSheet.Columns[1].Delete;



//yazıcı ön izleme
Kod:

ExcelApp.ActiveSheet.PrintPreview;



//yazıcı ya yazdır
Kod:

ExcelApp.ActiveSheet.PrintOut;



//excel sayfası kaydedilmişmi
Kod:

if not ExcelApp.ActiveWorkBook.Saved then showmessage('Kaydedilmemiş');



//sayfa kaydedilmiş mi
Kod:

ExcelApp.ActiveWorkBook.Saved := True;



//sayfayı kaydet
Kod:

ExcelApp.WorkBooks.Close;



//excel den çık
Kod:

ExcelApp.Quit;



//excel i görünür yap
Kod:

ExcelApplication1.Visible[0]:=True;



//Excel başlık bilgisini değiştir
Kod:

ExcelApplication1.Caption := 'deneme Microsoft Excel';



//Excel dosyasını açman farklı bir yolu
Kod:

ExcelApplication1.Workbooks.Open (c:\a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)



//sayfa aktif yap numara ile
Kod:

ExcelApplication1.WorkSheets[2].Activate; ?


//sayfa aktif yap isimle
Kod:

ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;



//hucreye bilgi yaz
Kod:

ExcelApplication1.Cells[1,4].Value := 'deneme';



//aktif sayfada kolon genişliğini ayarla
Kod:

ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;



//aktif sayfada satır yüksekliğini ayarla
Kod:

ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1??



//sayfa sonu koy
Kod:

ExcelApplication1.WorkSheets[1].Rows[8].PageBreak := 1;



//sayfa sonu koyma
Kod:

ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;



//chart kullanımı
Kod:

var asheet1,achart, range:variant;
asheet1:=ExcelApplication1.Workbooks[1].Worksheets[1];
achart:=asheet1.chartobjects.add(100,100,200,200);
achart.chart.charttype:=4;
series:=achart.chart.seriescollection;
range:='sheet1!r2c3:r3c9';
series.add(range,true);
achart.Chart.HasTitle:=True;
achart.Chart.ChartTitle.Characters.Text:=? Excle????



//ne ise yariyor bilmiyorum
Kod:

var i,j:integer;
ii:string;
begin

ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel Application';
try
ExcelApplication1.Workbooks.Open(ExtractFilePath(paramstr(0))+'???.xls',
null,null,null,null,null,null,null,null,null,null,null,null,0); //??????????????
except
ExcelApplication1.Disconnect;//?????????
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);//ExcelWorkbook1?Eexcelapplication1????
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);//Excelworksheet1?Excelworkbook1????



//ExcelApplication1.WorkBooks1.Close;
Kod:

ExcelApplication1.Disconnect;
ExcelApplication1.Quit;



//hücre birleştir.
Kod:

  bk.Sheets[1].Range['A1','E1'].MergeCells := true;
  bk.Sheets[1].Range['A1','E1'].HorizontalAlignment := $FFFFEFF4;
  bk.Sheets[1].Range['A1','E1'].VerticalAlignment := $FFFFEFF4;



//Yeni sayfa eklemek için
Kod:

Function ExcelAddWorkSheet(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.Worksheets.Add;
  Except
    MessageDlg('Unable to add a new worksheet', mtError, [mbOK], 0);
    Result := False;
  End;
End;



//excel i görününür yada görünmez yapmak için
Kod:

Function ExcelSetVisible(Excel : Variant;IsVisible: Boolean): Boolean;
Begin
  Result := True;
  Try
    Excel.Visible := IsVisible;
  Except
    MessageDlg('Unable to Excel Visibility', mtError, [mbOK], 0);
    Result := False;
  End;
End;



//exceli kapatmak için
Kod:

Function ExcelClose(Excel : Variant; SaveAll: Boolean): Boolean;
Begin
  Result := True;
  Try
    ExcelCloseWorkBooks(Excel, SaveAll);
    Excel.Quit;
  Except
    MessageDlg('Unable to Close Excel', mtError, [mbOK], 0);
    Result := False;
  End;
End;



//excel kitabını kapatmak için
Kod:

Function ExcelCloseWorkBooks(Excel : Variant; SaveAll: Boolean): Boolean;
var
  loop: byte;
Begin
  Result := True;
  Try
    For loop := 1 to Excel.Workbooks.Count Do
      Excel.Workbooks[1].Close[SaveAll];
  Except
    Result := False;
  End;
End;



//excel sayfansını isimle seçmek için
Kod:

Function ExcelSelectSheetByName(Excel : Variant; SheetName: String): Boolean;
Begin
  Result := True;
  Try
    Excel.Sheets[SheetName].Select;
  Except
    Result := False;
  End;
End;



//excel de bir hücreyi seçmek için
Kod:

Function ExcelSelectCell(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Begin
  Result := True;
  Try
    Excel.ActiveSheet.Cells[RowNum, ColNum].Select;
  Except
    Result := False;
  End;
End;



//Bir hücreden bilgi okumak için
Kod:

Function ExcelGetCellValue(Excel : Variant; RowNum, ColNum: Integer): ShortString;
Begin
  Result := '';
  Try
    Result := Excel.Cells[RowNum, ColNum].Value;
  Except
    Result := '';
  End;
End;



//excel de şu anki bulunulan satır
Kod:

Function ExcelGetRow(Excel : Variant): Integer;
Begin
  Try
    Result := Excel.ActiveCell.Row;
  Except
    Result := 1;
  End;
End;



//Excel de şu anda bulunulan kolon
Kod:

Function ExcelGetCol(Excel : Variant): Integer;
Begin
  Try
    Result := Excel.ActiveCell.Column;
  Except
    Result := 1;
  End;
End;



//Excel de en son kolonu seçmek
Kod:

Function ExcelGoToLastCol(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.Selection.End[xlToRight].Select;
  Except
    Result := False;
  End;
End;



//excel de en son satırı seçmek
Kod:

Function ExcelGoToLastRow(Excel : Variant): Boolean;
Begin
  Result := True;

  Try
    Excel.Selection.End[xlDown].Select;
  Except
    Result := False;
  End;
End;



//Excel de en üst satırı seçmek
Kod:

Function ExcelGoToTopRow(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.Selection.End[xlUp].Select;
  Except
    Result := False;
  End;
End;



//Excel de en sol kolonu seçmek
Kod:

Function ExcelGoToLeftmostCol(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.Selection.End[xlToLeft].Select;
  Except
    Result := False;
  End;
End;



//Excel de 1.satır ve 1. kolondaki hücreyi seçmek
Kod:

Function ExcelHome(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.ActiveSheet.Cells[1,1].Select;
  Except
    Result := False;
  End;
End;



//Excel de son satir son kolondaki hücreyi seçmek
Kod:

Function ExcelEnd(Excel : Variant): Boolean;
Begin
  Result := True;
  Try
    Excel.Selection.End[xlDown].Select;
    Excel.Selection.End[xlToRight].Select;
  Except
    Result := False;
  End;
End;



//Excel de en son kolonu seçmek bulunduğu satırda
Kod:

Function ExcelLastCol(Excel : Variant): Integer;
Var
  CurRow : Integer;
  CurCol : Integer;
Begin
  Result := 1;
  Try
    CurRow := Excel.ActiveCell.Row;
    CurCol := Excel.ActiveCell.Column;
    Result := CurCol;
    Excel.Selection.End[xlToRight].Select;
    Result := Excel.ActiveCell.Column;
    Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
  Except
  End;
End;



//Excel de en son satırı seçmek bulunduğu kolonda
Kod:

Function ExcelLastRow(Excel : Variant): Integer;
Var
  CurRow : Integer;
  CurCol : Integer;
Begin
  Result := 1;
  Try
    CurRow := Excel.ActiveCell.Row;
    CurCol := Excel.ActiveCell.Column;
    Result := CurRow;
    Excel.Selection.End[xlDown].Select;
    Result := Excel.ActiveCell.Row;
    Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
  Except
  End;
End;



//Excelde ilk satırı seçmek bulunduğu kolonda
Kod:

Function ExcelFirstRow(Excel : Variant): Integer;
Var
  CurRow : Integer;
  CurCol : Integer;
Begin
  Result := 1;
  Try
    CurRow := Excel.ActiveCell.Row;
    CurCol := Excel.ActiveCell.Column;
    Result := CurRow;
    Excel.Selection.End[xlUp].Select;
    Result := Excel.ActiveCell.Row;
    Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
  Except
  End;
End;



//excel de son kolonu seçmek bulunduğu satırda
Kod:

Function ExcelFirstCol(Excel : Variant): Integer;
Var
  CurRow : Integer;
  CurCol : Integer;
Begin
  Result := 1;
  Try
    CurRow := Excel.ActiveCell.Row;
    CurCol := Excel.ActiveCell.Column;
    Result := CurRow;
    Excel.Selection.End[xlToLeft].Select;
    Result := Excel.ActiveCell.Column;
    Excel.ActiveSheet.Cells[CurRow, CurCol].Select;
  Except
  End;
End;



//Excel de string arama yöntemi bulursa cursor oraya konumlanır.
Kod:

Function ExcelFindInRange(
  Excel       : Variant;
  FindString  : ShortString;
  TopRow      : Integer;
  LeftCol     : Integer;
  LastRow     : Integer;
  LastCol     : Integer): Boolean;
Begin
  Result :=
    ExcelFindValue(
      Excel,
      FindString,
      TopRow,
      LeftCol,
      LastRow,
      LastCol,
      True,
      True,
      True);
End;



//Excel de string arama yöntemi bulursa cursor oraya konumlanır. başka bir yöntem
Kod:

Function ExcelFind(
  Excel       : Variant;
  FindString  : ShortString): Boolean;
Begin
  Result :=
    ExcelFindInRange(
      Excel,
      FindString,
      ExcelFirstRow(Excel),
      ExcelFirstCol(Excel),
      ExcelLastRow(Excel),
      ExcelLastCol(Excel));
End;



//Excel den stringgrid e aktarma
Kod:

Function ExcelCopyToStringGrid(
  Excel                 : Variant;
  ExcelFirstRow         : Integer;
  ExcelFirstCol         : Integer;
  ExcelLastRow          : Integer;
  ExcelLastCol          : Integer;
  StringGrid            : TStringGrid;
  StringGridFirstRow    : Integer;
  StringGridFirstCol    : Integer;
  SizeStringGridToFit   : Boolean; {Make the StringGrid the same size as the input range}
  ClearStringGridFirst  : Boolean  {cells outside input range in StringGrid are cleared}
  ): Boolean;
Var
  C,R : Integer;
Begin
  Result := False;
  If ExcelLastCol < ExcelFirstCol Then Exit;
  If ExcelLastRow < ExcelFirstRow Then Exit;
  If (ExcelFirstRow < 1) Or (ExcelFirstRow > 255)   Then Exit;
  If (ExcelFirstCol < 1) Or (ExcelFirstCol > 30000) Then Exit;
  If (ExcelLastRow  < 1) Or (ExcelLastRow > 255)    Then Exit;
  If (ExcelLastCol  < 1) Or (ExcelLastCol > 30000)  Then Exit;
  If StringGrid = nil   Then Exit;
  If SizeStringGridToFit Then
  Begin
    StringGrid.ColCount := ExcelLastCol - ExcelFirstCol + StringGridFirstCol + 1;
    StringGrid.RowCount := ExcelLastRow - ExcelFirstRow + StringGridFirstRow + 1;
  End;
  If ClearStringGridFirst Then
  Begin
    C := StringGrid.ColCount;
    R := StringGrid.RowCount;
    StringGrid.ColCount := 1;
    StringGrid.RowCount := 1;
    StringGrid.Cells[0,0] := '';
    StringGrid.ColCount := C;
    StringGrid.RowCount := R;
  End;

  Result := True;
  For R := ExcelFirstRow To ExcelLastRow Do
  Begin
    For C := ExcelFirstCol To ExcelLastCol Do
    Begin
      Try
        StringGrid.Cells[
          C - ExcelFirstCol + StringGridFirstCol,
          R - ExcelFirstRow + StringGridFirstRow] :=
            Excel.Cells[R, C];
      Except
        Result := False;
      End;
    End;
  End;
End;



//Excel deki hücreye formul yazmak için
Kod:

Function ExcelSetCellFormula(
  Excel         : Variant;
  FormulaString : ShortString;
  RowNum, ColNum: Integer): Boolean;
Begin
  Result := True;
  Try
    Excel.
      ActiveSheet.
        Cells[RowNum, ColNum].
          Formula := FormulaString;
  Except
    Result := False;
  End;
End;



//Excel kolonundaki integer ları string e çevirmek için
Kod:

Function ExcelColIntToStr(ColNum: Integer): ShortString;
Var
  ColStr    : ShortString;
  Multiplier: Integer;
  Remainder : Integer;
Begin
  Result := '';
  If ColNum < 1   Then Exit;
  If ColNum > 256 Then Exit;
  Multiplier := ColNum div 26;
  Remainder  := ColNum Mod 26;
  If ColNum <= 26 Then
  Begin
    ColStr[1] := ' ';
    If Remainder = 0 Then
    Begin
      ColStr[2] := 'Z';
    End
    Else
    Begin
      ColStr[2] := Chr(Remainder+64);
    End;
  End
  Else
  Begin
    If Remainder = 0 Then
    Begin
      If Multiplier = 1 Then
      Begin
        ColStr[1] := ' ';
        ColStr[2] := 'Z';
      End
      Else
      Begin
        ColStr[1] := Chr(Multiplier+64-1);
        ColStr[2] := 'Z';
      End;
    End
    Else
    Begin
      ColStr[1] := Chr(Multiplier+64);
      ColStr[2] := Chr(Remainder+64);
    End;
  End;
  If ColStr[1] = ' ' Then
  Begin
    Result := Result + ColStr[2];
  End
  Else
  Begin
    Result := Result + ColStr[1] + ColStr[2];
  End;
  Result := Result;
End;



//Excel kolonundaki string leri integer a çevirmek için
Kod:

Function ExcelColStrToInt(ColStr: ShortString): Integer;
Var
  ColStrNew  : ShortString;
  i          : Integer;
  RetVal     : Integer;
  Multiplier : Integer;
  Remainder  : Integer;
Begin
  RetVal := 1;
  Result := RetVal;
  ColStrNew := '';
  For i := 1 To Length(ColStr) Do
  Begin
    If ((Ord(ColStr[i]) >=  65)  And
       ( Ord(ColStr[i]) <=  90)) Or
       ((Ord(ColStr[i]) >=  97)  And
       ( Ord(ColStr[i]) <= 122)) Then
    Begin
      ColStrNew := ColStrNew + UpperCase(ColStr[i]);
    End;
  End;
  If Length(ColStrNew) < 1 Then Exit;
  If Length(ColStrNew) < 2 Then
  Begin
    RetVal := Ord(ColStrNew[1])-64;
  End
  Else
  Begin
    Multiplier := Ord(ColStrNew[1])-64;
    Remainder  := Ord(ColStrNew[2])-64;
    Retval     := (Multiplier * 26) + Remainder;
  End;
  Result := RetVal;
End;



//Excel hücresine kısa string yazmak için
Kod:

Function ExcelSetCellValue(
  Excel : Variant;
  RowNum, ColNum: Integer;
  Value : ShortString): Boolean;
Begin
  Try
    Excel.Cells[RowNum, ColNum].Value := Value;
    Result := True;
  Except
    Result := False;
  End;
End;



//Excel dosyası açmak için şifresiz olanlarda
Kod:

Function ExcelOpenFile(Excel : Variant; FileName : String): Boolean;
Begin
  Result := True;
  try
    //Open the database that we want to work with
    Excel.Workbooks.Open[FileName];
  except
    MessageDlg('Unable to locate '+FileName, mtError, [mbOK], 0);
    Result := False;
  end;
End;



//Excel dosyasını parametreli açmak için. Şifreli veya read only gibi
Kod:

{
Excel
  The OLEObject passed as an argument.

FileName
  Required. Specifies the filename of the workbook to open.

UpdateLinks
  Specifies how links in the file are updated. If this
  argument is omitted, the user is prompted to determine
  how to update links. Otherwise, this argument is one of
  the values shown in the following table.
  Value   Meaning
  0   No updates
  1   Updates external but not remote references
  2   Updates remote but not external references
  3   Updates both remote and external references

  If Microsoft Excel is opening a file in the WKS, WK1, or
  WK3 format and the updateLinks argument is 2, Microsoft
  Excel generates charts from the graphs attached to the file.
  If the argument is 0, no charts are created.

ReadOnly
  If True, the workbook is opened in read-only mode.

Format
  If Microsoft Excel is opening a text file, this argument
  specifies the delimiter character, as shown in the following
  table. If this argument is omitted, the current delimiter
  is used.

  Value   Delimiter
  1   Tabs
  2   Commas
  3   Spaces
  4   Semicolons
  5   Nothing
  6   Custom character, see the delimiter argument.

Password
  A string containing the password required to open a
  protected workbook. If omitted and the workbook requires
  a password, the user is prompted for the password.
}

Function ExcelOpenFileComplex(
  Excel        : Variant;
  FileName     : String;
  UpdateLinks  : Integer;
  ReadOnly     : Boolean;
  Format       : Integer;
  Password     : ShortString): Boolean;
Begin
  Result := True;
  try
    //Open the database that we want to work with
    Excel.
      Workbooks.
        Open[
          FileName,
          UpdateLinks,
          ReadOnly,
          Format,
          Password];
  except
    MessageDlg('Unable to locate '+FileName, mtError, [mbOK], 0);
    Result := False;
  end;
End;



//Excel deki sayfayı text dosyaya kaydetmek için
Kod:

Function ExcelSaveAsText(
  Excel         : Variant;
  ExcelFirstRow : Integer;
  ExcelFirstCol : Integer;
  ExcelLastRow  : Integer;
  ExcelLastCol  : Integer;
  OutFilePath   : ShortString;
  OutFileName   : ShortString): Boolean;
{
OutFileFormat: Use one of the following
xlAddIn      xlExcel3         xlTextMSDOS
xlCSV        xlExcel4         xlTextWindows
xlCSVMac     xlExcel4Workbook xlTextPrinter
xlCSVMSDOS   xlIntlAddIn      xlWK1
xlCSVWindows xlIntlMacro      xlWK3
xlDBF2       xlNormal         xlWKS
xlDBF3       xlSYLK           xlWQ1
xlDBF4       xlTemplate       xlWK3FM3
xlDIF        xlText           xlWK1FMT
xlExcel2     xlTextMac        xlWK1ALL
}
Var
  FullOutName : String;
Begin
  Try
    If OutFilePath <> '' Then
    Begin
      If Not (Copy(OutFilePath,Length(OutFilePath),1) = '\') Then
      Begin
        OutFilePath := OutFilePath + '\';
      End;
    End;
    FullOutName := OutFilePath + OutFileName;
    If FileExists(FullOutName) Then DeleteFile(FullOutName);

    If ExcelVersion(Excel) = '8.0' Then
    Begin
      ExcelSelectCell(Excel,ExcelFirstRow,ExcelFirstCol);
      ExcelSelectBlockWhole(Excel);
      //Excel.SendKeys('^+{END}');
    End
    Else
    Begin
      Excel.
        Range(
          ExcelColIntToStr(ExcelFirstCol)+
          IntToStr(ExcelFirstRow)+
          ':'+
          ExcelColIntToStr(ExcelLastCol)+
          IntToStr(ExcelLastRow)
              ).
          Select;
    End;
{
  FileFormat = (xlAddIn, xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows, xlDBF2,
                xlDBF3, xlDBF4, xlDIF, xlExcel2, xlExcel3, xlExcel4,
                xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlNormal,
                xlSYLK, xlTemplate, xlText, xlTextMac, xlTextMSDOS,
                xlTextWindows, xlTextPrinter, xlWK1, xlWK3, xlWKS,
                xlWQ1, xlWK3FM3, xlWK1FMT, xlWK1ALL);
}
(*
    //CHECKING OUT THE GARBLED OUTPUT
    //  Produces an *.xls
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'02',xlCSV);
*)
    //  Produces an *.txt
//    Excel.
//      ActiveSheet.
//      SaveAs(
//        FullOutName,xlCSVMSDOS);
(*
    //  Produces nothing
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'05',xlCSVWindows);

    //  Produces nothing
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'06',xlDBF2);

    //  Produces an *.txt comma separated
    Excel.
      ActiveSheet.
      SaveAs(
        FullOutName,xlDBF3);
*)
    //  Produces an *.txt
    Excel.
      ActiveSheet.
      SaveAs(
        FullOutName,xlTextMSDOS);
(*
    //  Produces an *.dbf
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'08',xlDBF4);
    //  Produces an *.dbf
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'09',xlDIF);
    //  Produces an *.dif
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'10',xlExcel2);
    //  Produces an *.slk
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'11',xlExcel3);
    //  Produces an *.dbf
    Excel.
      ActiveSheet.
      SaveAs(
        OutFilePath+OutFileName+'12',xlExcel4);

*)
    Result := True;
  Except
    Result := False;
  End;
End;



//Excel sayfasından seçimli kopyalama yapmak için.Sadece değerler yapıştırılır.
Kod:

Function ExcelPasteValuesOnly(
  Excel         : Variant;
  ExcelFirstRow : Integer;
  ExcelFirstCol : Integer;
  ExcelLastRow  : Integer;
  ExcelLastCol  : Integer): Boolean;
Begin
  Result := True;
  try
    If ExcelVersion(Excel) = '8.0' Then
    Begin
      If Not ExcelSelectRange(
               Excel,
               ExcelFirstRow,
               ExcelFirstCol,
               ExcelLastRow,
               ExcelLastCol)
      Then
      Begin
        Result := False;
        ShowMessage('Unable to select the range to paste as values.');
        Exit;
      End;
      Excel.Selection.Copy;
      Excel.Selection.PasteSpecial(xlValues);
      Excel.Application.CutCopyMode := False;
    End
    Else
    Begin
      Excel.Range(
        ExcelColIntToStr(ExcelFirstCol)+IntToStr(ExcelFirstRow)+
        ':'+
        ExcelColIntToStr(ExcelLastCol)+IntToStr(ExcelLastRow)).Select;
      Excel.Selection.Copy;
      Excel.Selection.PasteSpecial(xlValues);
      Excel.Application.CutCopyMode := False;
      Excel.Selection.Replace('#N/A','0');
    End;
  except
    ShowMessage('Unable to paste range as values');
    Result := False;
  end;
End;



//Kolon genişliğini ayarlamak için
Kod:

Function ExcelSetColumnWidth(Excel : Variant; ColNum, ColumnWidth: Integer): Boolean;
Var
  RowWas : Integer;
  ColWas : Integer;
Begin
  Try
    RowWas := ExcelGetRow(Excel);
    ColWas := ExcelGetCol(Excel);
    ExcelSelectCell(Excel,1,ColNum);
    Excel.Selection.ColumnWidth := ColumnWidth;
    ExcelSelectCell(Excel,RowWas,ColWas);
    Result := True;
  Except
    Result := False;
  End;
End;



//Excel de bir alanı seçmek için
Kod:

Function ExcelSelectRange(
    Excel    : Variant;
    FirstRow : Integer;
    FirstCol : Integer;
    LastRow  : Integer;
    LastCol  : Integer): Boolean;
Var
  r,c : Integer;
Begin
  Result := False;
  Try
    If FirstRow <   1 Then Exit;
    If FirstCol <   1 Then Exit;
    If LastRow  <   1 Then Exit;
    If LastCol  <   1 Then Exit;
    If FirstCol > 255 Then Exit;
    If LastCol  > 255 Then Exit;

    If Not ExcelSelectCell(
             Excel,
             FirstRow,
             FirstCol)
    Then
    Begin
      Exit;
    End;
    {Check for strange number combinations}
    If FirstRow = LastRow Then
    Begin
      {Don't need to do anything}
    End
    Else
    Begin
      If FirstRow < LastRow Then
      Begin
        For r := FirstRow To LastRow - 1 Do
        Begin
          Excel.SendKeys('+{DOWN}');
        End;
      End
      Else
      Begin
        For r := LastRow To FirstRow - 1 Do
        Begin
          Excel.SendKeys('+{UP}');
        End;
      End;
    End;
    If FirstCol = LastCol Then
    Begin
      {Don't need to do anything}
    End
    Else
    Begin
      If FirstCol < LastCol Then
      Begin
        For c := FirstCol To LastCol - 1 Do
        Begin
          Excel.SendKeys('+{RIGHT}');
        End;
      End
      Else
      Begin
        For c := LastCol To FirstCol - 1 Do
        Begin
          Excel.SendKeys('+{LEFT}');
        End;
      End;
    End;
    Result := True;
  Except
    Result := False;
  End;
End;



//Excelde blok seçmek sendkey işlemi ile
Kod:

Function ExcelSelectBlock(
    Excel    : Variant;
    FirstRow : Integer;
    FirstCol : Integer): Boolean;
Begin
  Try
    ExcelSelectCell(Excel,FirstRow,FirstCol);
    Excel.SendKeys('+{END}+{RIGHT}');
    Excel.SendKeys('+{END}+{DOWN}');
    Result := True;
  Except
    Result := False;
  End;
End;



//Excel sayfasının tamamını seçmek için
Kod:

Function ExcelSelectBlockWhole(Excel: Variant): Boolean;
Var
  FirstRow : Integer;
  FirstCol : Integer;
  RowWas   : Integer;
  ColWas   : Integer;
Begin
  Try
    RowWas   := ExcelGetRow(Excel);
    ColWas   := ExcelGetCol(Excel);

    {If the base cell is on a side of the block, the block
    will not be created properly.}

    {View From Original Cell}
    FirstRow := ExcelFirstRow(Excel);
    FirstCol := ExcelFirstCol(Excel);
    If (Not IsBlockColSide(Excel,RowWas,ColWas)) And
       (Not IsBlockRowSide(Excel,RowWas,ColWas)) Then
    Begin
      {Cell is not on a side of the block}
      ExcelSelectCell(Excel,FirstRow,FirstCol);
      Excel.SendKeys('+{END}+{RIGHT}');
      Excel.SendKeys('+{END}+{DOWN}');
      Result := True;
      Exit;
    End;
    {Row Only problem}
    If (Not IsBlockColSide(Excel,RowWas,ColWas)) And
       (IsBlockRowSide(Excel,RowWas,ColWas)) Then
    Begin
      {DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
      BLOCK IS TOWARD BOTTOM RIGHT}
      ExcelSelectCell(Excel,RowWas,FirstCol);
      Excel.SendKeys('+{END}+{RIGHT}');
      Excel.SendKeys('+{END}+{DOWN}');
      Result := True;
      Exit;
    End;
    {Column Only problem}
    If (IsBlockColSide(Excel,RowWas,ColWas)) And
       (Not IsBlockRowSide(Excel,RowWas,ColWas)) Then
    Begin
      {DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
      BLOCK IS TOWARD BOTTOM RIGHT}
      ExcelSelectCell(Excel,FirstRow,ColWas);
      Excel.SendKeys('+{END}+{RIGHT}');
      Excel.SendKeys('+{END}+{DOWN}');
      Result := True;
      Exit;
    End;
    {DEFAULT TO ASSUMING SELECTED CELLS ARE NEAR TOP LEFT AND
    BLOCK IS TOWARD BOTTOM RIGHT}
    ExcelSelectCell(Excel,RowWas,ColWas);
    Excel.SendKeys('+{END}+{RIGHT}');
    Excel.SendKeys('+{END}+{DOWN}');
    Result := True;
  Except
    Result := False;
  End;
End;



//Bunun ne olduğunu bilmiyorum
Kod:

Function IsBlockColSide(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Var
  CellFirstSide     : Integer;
  CellLastSide      : Integer;
  FirstSideLastSide : Integer;
  LastSideFirstSide : Integer;
Begin
  ExcelSelectCell(Excel,RowNum,ColNum);
  CellFirstSide := ExcelFirstCol(Excel);
  CellLastSide  := ExcelLastCol(Excel);
  ExcelSelectCell(Excel,RowNum,CellFirstSide);
  FirstSideLastSide := ExcelLastCol(Excel);
  ExcelSelectCell(Excel,RowNum,CellLastSide);
  LastSideFirstSide := ExcelFirstCol(Excel);
  ExcelSelectCell(Excel,RowNum,ColNum);
  If (LastSideFirstSide = ColNum) Or
     (FirstSideLastSide = ColNum) Then
  Begin
    Result := True;
  End
  Else
  Begin
    Result := False;
  End;
End;



//Bunun ne olduğunu bilmiyorum
Kod:

Function IsBlockRowSide(Excel : Variant; RowNum, ColNum: Integer): Boolean;
Var
  CellFirstSide     : Integer;
  CellLastSide      : Integer;
  FirstSideLastSide : Integer;
  LastSideFirstSide : Integer;
Begin
  ExcelSelectCell(Excel,RowNum,ColNum);
  CellFirstSide := ExcelFirstRow(Excel);
  CellLastSide  := ExcelLastRow(Excel);
  ExcelSelectCell(Excel,CellFirstSide,ColNum);
  FirstSideLastSide := ExcelLastRow(Excel);
  ExcelSelectCell(Excel,CellLastSide,ColNum);
  LastSideFirstSide := ExcelFirstRow(Excel);
  ExcelSelectCell(Excel,RowNum,ColNum);
  If (LastSideFirstSide = RowNum) Or
     (FirstSideLastSide = RowNum) Then
  Begin
    Result := True;
  End
  Else
  Begin
    Result := False;
  End;
End;



//Excel de sayfa ismini değiştirmek için
Kod:

Function ExcelRenameSheet(
  Excel         : Variant;
  OldName       : ShortString;
  NewName       : ShortString): Boolean;
Begin
  Try
    Excel.Sheets(OldName).Name := NewName;
    Result := True;
  Except
    Result := False;
  End;
End;



//Excel de sayfayı silmek için sayfa1 gibi
Kod:

Function ExcelDeleteWorkSheet(
  Excel     : Variant;
  SheetName : ShortString): Boolean;
Begin
  Try
    If Not ExcelSelectSheetByName(Excel,SheetName) Then
    Begin
      ShowMessage('Could not select the '+SheetName+' WorkSheet');
      Result := False;
      Exit;
    End;
    Excel.ActiveWindow.SelectedSheets.Delete;
    Result := True;
  Except
    Result := False;
  End;
End;



//Şu anda kullanılan sayfanın ismi getirir.
Kod:

Function ExcelGetActiveSheetName(Excel : Variant): ShortString;
Begin
  Result := '';
  Try
    Result := Excel.ActiveSheet.Name;
  Except
    Result := '';
  End;
End;



//Sadece değerleri yapıştırır.
Kod:

Function ExcelValuesOnly(
  Excel         : Variant;
  ExcelFirstRow : Integer;
  ExcelFirstCol : Integer;
  ExcelLastRow  : Integer;
  ExcelLastCol  : Integer): Boolean;
Var
  r,c : Integer;
  s   : ShortString;
Begin
  Try
    If ExcelVersion(Excel) = '8.0' Then
    Begin
      For r := ExcelFirstRow To ExcelLastRow Do
      Begin
        For c := ExcelFirstCol To ExcelLastCol Do
        Begin
          s := Excel.Cells[r,c].Value;
          Excel.Cells[r, c].Value := s;
        End;
      End;
    End
    Else
    Begin
      ExcelPasteValuesOnly(
        Excel,
        ExcelFirstRow,
        ExcelFirstCol,
        ExcelLastRow,
        ExcelLastCol);
    End;
    Result := True;;
  Except
    Result := False;
  End;
End;



//Excel hücresindeki formulü getirir.
Kod:

Function ExcelGetCellFormula(
  Excel         : Variant;
  RowNum, ColNum: Integer): ShortString;
Begin
  Result := ' ';
  Try
    Result := Excel.
                ActiveSheet.
                Cells[RowNum, ColNum].
                Formula;
  Except
    Result := ' ';
  End;
End;



//Excel in versiyon bilgisini döndürür.
Kod:

Function ExcelVersion(Excel: Variant): ShortString;
Var
  Version : ShortString;
Begin
  Result := '';
  Try
    Version := Excel.Version;
    Result := Version;
  Except
    Result := '';
  End;

END;



Her Yönü ile Delphi ve Excel 23 Haziran 2004 12:31
mefev2 
Uses satırına  eklenecek  
ComObj 

Değişkenlerimi tanımlayalım  
  
   var 
     XLApp : OleVariant;
     ColonAraligi : OleVariant;
   const
      alignCenter = -4108;
      valignCenter = -4108;
      alignRight =- 4152;



Excel Kontrolu  

try 
  XLApp := GetActiveOleObject('Excel.Application'); 
  except 
    try 
      XLApp := CreateOleObject('Excel.Application'); 
    except 
      ShowMessage('Excel kurulu değil'); 
      Exit; 
    end; 
  end; 




Var olan br excel'i açma  
XLApp.Workbooks.Open('c:\gerizekali.xls'); 


Yeni çalışma sayfası ekler.  
XLApp.WorkBooks.Add; 


Yeniden adlandır  
XLApp.ActiveSheet.Name := 'geri zekali'; 
//Aktif Sayfanın ismini değiştirir

XLApp.Workbooks[1].WorkSheets[1].Name := 'GeriZekali'; 
//Belirttiğiniz sayfanın ismini değişirir.


Excel görünsün, görünmesin  
XLApp.Visible := True; 
//Gösterir
XLApp.Visible := False; 
//Gizler 


Hücre Seçme  
XLApp.Range('A1:J25').Select; 


Hücreleri Birleştirme  
XLApp.Range['A1:C1'].Mergecells := True; 
//A1 den C1 e kadar olan hücreleri birleştirir


Hücre Hizalama  
XLApp.Cells[1, 1].HorizontalAlignment := AlignCenter; 
//Yatay Hizalama

XLApp.Cells[1, 1].VerticalAlignment := valignCenter; 
//Dikey Hizalama


Satır Yüksekliği  
XLApp.Rows[1].RowHeight := 30; 


Border  
XLApp.Range[A1,C1].Borders.Weight := 1; 


Border Rengi  
XLApp.Cells[1, 1]..Borders[1].Colorindex := -4142; 


Font Ayarları  
XLApp.Range['A1:A1'].Font.Bold := True; 
//Bold yapar


XLApp.Range['A1:A1'].Font.Size := 12; 
//Size 12 yapar


Gridleri gizler  
XLApp.ActiveWindow.DisplayGridlines := False; 


Değer atama  
XLApp.Cells[1, 1].Value := 'Ben bir Geri Zekalıyım'; 
//yukarida A,C hücrelerini birleştirdiğimiz için  bundan sonra aynı satırda bir sonraki hücreye bir değer atamak istersek
XLApp.Cells[1, 4].Value := 'deneme';  dememiz gerekli


Kolon Aralığı  
ColonAraligi := XLApp.Workbooks[1].WorkSheets[1].Columns;
ColonAraligi.Columns[4].ColumnWidth := 25;

//burada  ColonAraligi : OleVariant;  değişkenimizden yararlandık, 4. kolonun genişliğini 25 yaptık.

//Kolon Otomatik Genişlesin
XLApp.selection.Columns.AutoFit; 



Rakamları Formatlama  
XLApp.WorkBooks[1].WorkSheets[1].Columns[2].NumberFormat := '#.##0'; 
//2 kolona girilecek sayıları formatladık 1.250.000 şeklinde

XLApp.WorkBooks[1].WorkSheets[1].Columns[2].NumberFormat := ''; 
//Formatlı bir hücreyi formatsız yapar.


Tarih Formatlama  
XLApp.Cells[1,1].Value := FormatDateTime('dd-mmm-yyyy', Now); 


Formuller  
XLApp.Range['A5', 'A5'].Formula := '=Sum(A1:A4)'; 
//A1 hücresinden A4 hücresine kadar Toplar Değerlerini A5 hücresine yazar. 


Kaydet  
XLApp.SaveAs('c:\GeriZekali.xls'); 
//Çalışma sayfasını kaydeder

XLApp.ActiveWorkBook.SaveAs('c:\GeriZekali.xls'); 
//Aktif sayfayı kaydeder.


Yazıcı Ayarları  
//Kenarlıklar

XLApp.ActiveSheet.PageSetup.LeftMargin := 0;
XLApp.ActiveSheet.PageSetup.RightMargin := 0;
XLApp.ActiveSheet.PageSetup.TopMargin := 0;
XLApp.ActiveSheet.PageSetup.BottomMargin := 0;
  


//Hizalama
XLApp.ActiveSheet.PageSetup.CenterHorizontally := 1; 
//Yatay Olarak Ortaya alır
XLApp.ActiveSheet.PageSetup.CenterVertically := 1; 
//Dikey Olarak Ortaya Alır

//Sayfa Ayarları
XLApp.ActiveSheet.PageSetup.Orientation := 2; 
//2 yatay 1 dikey olarak ayarlar.


Alt Bilgi  
  XLApp.ActiveSheet.PageSetup.LeftFooter := 'Rapor Tarihi : ' + '&D'; 
//O günü tarihini sayfanın alt bilgi kısmına basalım


Kaçıncı Sayfa  
XLApp.ActiveSheet.PageSetup.RightFooter := 'Sayfa : ' + '&P'+'/'+'&N'; 
//Yazıcıdan aldığımız sayfaların kaç sayfada hangi sayfa bilgisini gösterir


Alt Bilgi için diğer parametreler  

    &L
    &C
    &R
    &E
    &X
    &Y
    &B
    &I
    &U
    &S
    &D
    &T
    &F
    &A
    &P
    &P+number
    &P-number
    &&
    & "Font Adı"
    &nn
    &N

//bunarın karşılıklarınıda artık zahmet edip tektek deneyerek anlamlarını bulunuz. ) (Yaşasın Kötülük)



Tekrar Eden Saatırlar  
XLApp.ActiveSheet.PageSetup.PrintTitleRows := '$2:$2'; 
//Yazılan Sayfada başlık olarak tekrar etmesini sağlarız.
İstediğiniz hücreleri $2:$2 dediğimizde ikinci satırı olduğu gibi her print edilen sayfanın başında gösterir


Yazıcı Renkli, Renksiz  
XLApp.ActiveSheet.PageSetup.BlackAndWhite := False;  

Yazıcı Görüntüsü  
XLApp.ActiveSheet.PrintPreview; 


Kopya Sayısı  
XLApp.ActiveWindow.SelectedSheets.PrintOut (Copies := 1); 
//Kaç Kopyası Olsun


//Sığdır 
XLApp.ActiveSheet.PageSetup.Zoom := 65; 
//Çalışma Sayfanızı 1 Sayfaya Sığdırır.


Kapat  

if not VarIsEmpty(XLApp) then
begin 
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLApp:=unassigned;

//Formunuzun OnDestroy olayına bu satırları yazınki form kapandığında Excel havada asılı kalmasın.

Umarım işinize yarar

--mefe--
geri_zekali@hotmail.com 



ercanskose
Üye
Mesajlar: 62
Kayıt: 18 Eyl 2011 02:31

Re: Excele aktarma

Mesaj gönderen ercanskose »

excele aktarma konusunda cxgrid biçilmiş kaftan tek satır kodla excele düzenli bir şekilde veri aktarıyor. bence cxgrid i dene.
Cevapla