Delphi Can
DBGrid den Excel Aktarımı - Baskı Önizleme

+- Delphi Can (https://www.delphican.com)
+-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Genel Programlama (https://www.delphican.com/forumdisplay.php?fid=6)
+--- Konu Başlığı: DBGrid den Excel Aktarımı (/showthread.php?tid=5985)

Sayfalar: 1 2 3 4

Cvp: DBGrid den Excel Aktarımı - OZCANK - 15-05-2021

(15-05-2021, Saat: 13:35)emozgun Adlı Kullanıcıdan Alıntı: @OZCANK @CesuRnın dediği gibi text formata döndürme sıkıntılı görünüyor. Şunu dener misin?
  satir := 1;
  sutun := 1;
  DBGDataset.First;
  While not DBGDataset.EOF do begin
    for i := 0 to DBGrid2.Columns.Count-1 do
      Excel.Cells[satir,sutun+i].Value := DBGrid2.Columns[i].Field.Value;
    DBGDataset.Next;
    inc(Satir);
  end;

Bu şekilde değiştirdim ama dip toplamı almadı birde Belge no daki sıfırları yok ediyor

procedure DBGridToExcell(DBG:TDBGrid; FileName:String);
var
 Sheet:OleVariant;
 Excel, WorkBook:Variant;
 DBGDataset: TDataSet;
 Row,Col,RNo,i:Integer;
begin
 DBGDataset:=DBG.DataSource.DataSet;
 RNo:=DBGDataset.RecNo;
 DBGDataset.DisableControls;
 Excel:= CreateOleObject('Excel.Application');
 Excel.Visible :=False;
 WorkBook :=Excel.WorkBooks.Add;
 Sheet:=WorkBook.WorkSheets[1];
 try
   For Row:=0 to DBG.Columns.Count-1 do
   begin
     Sheet.Cells[1,Row+1]:=DBG.Columns[Row].Title.Caption;
     Sheet.Columns[Row+1].ColumnWidth:=(0.139*DBG.Columns[Row].Width);
     Sheet.Range['A1','AD1'].Font.Bold:=True;
     Sheet.Range['A1','AD1'].Font.Color:=clRed;
 End;
   DBGDataset.First;
   Col:=1;
   Row:=2;

   //    While not(DBGDataset.Eof) do
//    begin
//      Col:=Col+1;
//      For Row:=0 to DBG.Columns.Count-1 do
//  begin
//        Excel.Cells[Col,Row+1].HorizontalAlignment :=-4131;
//        Sheet.Cells[Col,Row+1]:=DBG.Columns[Row].Field.AsString;
//        Sheet.Columns[2]. NumberFormat := '@';
//      End;
//     DBGDataset.Next;
//  End;


//  Col := 1;
 DBGDataset.First;
 While not DBGDataset.EOF do begin
   for i := 0 to DBG.Columns.Count-1 do
     Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
   DBGDataset.Next;
   inc(Row);
 end;
   Inc(Col);
   Sheet.Cells[Col,8].Formula := '=SUM(H2:H'  + InttoStr(Col - 1) + ')';
//    Sheet.Cells[Col,8].Formula := '=SAYIYAÇEVİR(H2'  + InttoStr(Col - 1) + ')';

   //    Sheet.Cells[Col,8].Formula :='+FormatFloat('#,##0', float));
   Sheet.Columns['A:AC'].EntireColumn.AutoFit;
   WorkBook.SaveAs(FileName);
   showmessage('Kayıtlar Excele Başarılı Bir Şekilde Aktarıldı');
 finally
   EXCEL.DisplayAlerts := False;
   EXCEL.Quit;
   EXCEL:=Unassigned;
   DBGDataset.RecNo:=RNo;
   DBGDataset.EnableControls;
   Excel := Null;
   Sheet := Null;
End;
End;


Cvp: DBGrid den Excel Aktarımı - emozgun - 15-05-2021

D7 ve Excel 2007'de integer ve tdateme alanları olan tablodan aktarıp dip toplamı almayı denedim alıyor. DBGDataset tablo yapısında integer, float, tdatetime alanlar dışındakilerde (araya string karışmışsa) almayabilir. Bir de DBGDataset çıft tıklayınca (Field Editor'de) tüm sayı alanları "string"e dönüştürülmemiş olmalı.
Belge no daki sıfırları yok etmemesi için 
 While not DBGDataset.EOF do begin
  for i := 0 to DBG.Columns.Count-1 do 
    if i = BelgeNoAlanNumarası then
     Excel.Cells[Row,Col+i]]:=DBG.Columns[i].Field.AsString
    else
      Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
  DBGDataset.Next;
  inc(Row);
end;


Cvp: DBGrid den Excel Aktarımı - OZCANK - 15-05-2021

(15-05-2021, Saat: 14:19)emozgun Adlı Kullanıcıdan Alıntı: D7 ve Excel 2007'de integer ve tdateme alanları olan tablodan aktarıp dip toplamı almayı denedim alıyor. DBGDataset tablo yapısında integer, float, tdatetime alanlar dışındakilerde (araya string karışmışsa) almayabilir. Bir de DBGDataset çıft tıklayınca (Field Editor'de) tüm sayı alanları "string"e dönüştürülmemiş olmalı.
Belge no daki sıfırları yok etmemesi için 
 While not DBGDataset.EOF do begin
  for i := 0 to DBG.Columns.Count-1 do 
    if i = BelgeNoAlanNumarası then
     Excel.Cells[Row,Col+i]]:=DBG.Columns[i].Field.AsString
    else
      Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
  DBGDataset.Next;
  inc(Row);
end;

Bu şekilde geliyor toplamlar şimdilik tamam ama sıfırları Fatura No da yok ediyor birde bu ₺ işareti nerden geldi anlamadım bazı alanlarda var bazılarında yok. Resim olarak ektedir.
(15-05-2021, Saat: 14:19)emozgun Adlı Kullanıcıdan Alıntı: D7 ve Excel 2007'de integer ve tdateme alanları olan tablodan aktarıp dip toplamı almayı denedim alıyor. DBGDataset tablo yapısında integer, float, tdatetime alanlar dışındakilerde (araya string karışmışsa) almayabilir. Bir de DBGDataset çıft tıklayınca (Field Editor'de) tüm sayı alanları "string"e dönüştürülmemiş olmalı.
Belge no daki sıfırları yok etmemesi için 
 While not DBGDataset.EOF do begin
  for i := 0 to DBG.Columns.Count-1 do 
    if i = BelgeNoAlanNumarası then
     Excel.Cells[Row,Col+i]]:=DBG.Columns[i].Field.AsString
    else
      Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
  DBGDataset.Next;
  inc(Row);
end;

Bu şekilde geliyor toplamlar şimdilik tamam ama sıfırları Fatura No da yok ediyor birde bu ₺ işareti nerden geldi anlamadım bazı alanlarda var bazılarında yok. Resim olarak ektedir.

Cvp: DBGrid den Excel Aktarımı - emozgun - 15-05-2021

if'leri artırmalısın. case ile daha kolay olur:
While not DBGDataset.EOF do begin
 for i := 0 to DBG.Columns.Count-1 do
      case i of
        0,1,2,4,5,7 : Excel.Cells[Row,Col+i]] := DBG.Columns[i].Field.AsString; //7=BelgeNoAlanNumarası
        3 : Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.AsInteger; //Miktar
        6 : Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.AsCurrency; //Tutar
        else
          Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
      end;
 DBGDataset.Next;
 inc(Row);
end;


Cvp: DBGrid den Excel Aktarımı - OZCANK - 15-05-2021

(15-05-2021, Saat: 16:38)emozgun Adlı Kullanıcıdan Alıntı: if'leri artırmalısın. case ile daha kolay olur:
While not DBGDataset.EOF do begin
 for i := 0 to DBG.Columns.Count-1 do
      case i of
        0,1,2,4,5,7 : Excel.Cells[Row,Col+i]] := DBG.Columns[i].Field.AsString; //7=BelgeNoAlanNumarası
        3 : Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.AsInteger; //Miktar
        6 : Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.AsCurrency; //Tutar
        else
          Excel.Cells[Row,Col+i].Value := DBG.Columns[i].Field.Value;
      end;
 DBGDataset.Next;
 inc(Row);
end;
Üstadım Çok teşekkür ederim. Yüreğine sağlık. Bu şekilde sonuca ulaştım; Veriler artınca bekleme süresi de uzuyor buraya "Lütfen Bekleyiniz"  nasıl ekleyebilirim?

 
   DBGDataset.First;
   Row := 2;
   Col := 1;
 DBGDataset.First;
 While not DBGDataset.EOF do begin
   Sheet.Columns[2]. NumberFormat := '@';
   Sheet.Columns[5]. NumberFormat := '########';
   Sheet.Columns[9]. NumberFormat := '#.00';

   for S := 0 to DBG.Columns.Count-1 do
   Excel.Cells[Row,Col+S].Value := DBG.Columns[S].Field.Value;

DBGDataset.Next;
   inc(Row);
 end;
   Sheet.Cells[Row,8].Formula  := '=SUM(H2:H'  + InttoStr(Row - 1) + ')';
   Sheet.Cells[Row,10].Formula := '=SUM(J2:J'  + InttoStr(Row - 1) + ')';

   Sheet.Columns['A:AC'].EntireColumn.AutoFit;
   WorkBook.SaveAs(FileName);
   showmessage('Kayıtlar Excele Başarılı Bir Şekilde Aktarıldı');
 finally


Cvp: DBGrid den Excel Aktarımı - CesuR - 15-05-2021

Merhaba, excell de istenilen satırın hücre biçimini rakamsal olarak ayarlamak ve istedin satıra formul eklemek için ufak bir örnek hazırladım. Bu örneğe bakarak uygulamandaki sorunu çözebileceğini umuyorum.  Kolay gelsin

uses kısmına excel için comobj eklemeyi unutmayın. Bunu ekledikten sonra değişkenlerimizi tanıtalım
var
 Form1: TForm1;
 EXCEL,CALISMA_KITABI,CALISMA_SAYFASI:variant;


Sıra geldi prosedürümüze

Procedure EXCELE_YOLLA;
BEGIN

 EXCEL := CREATEOLEOBJECT('excel.application');
 EXCEL.VISIBLE  :=FALSE;
 CALISMA_KITABI :=EXCEL.WORKBOOKS.ADD;
 CALISMA_SAYFASI:=CALISMA_KITABI.ActiveSheet;

 TRY
 CALISMA_SAYFASI.columns['C'].NumberFormat := '0,000';
 // C SUTUNUNUN BİÇİMİNİ RAKAMSAL OLARAK FORMATLADIK.
 // BÜTÜN SÜTUNU DEĞİL SADECE BELLİ HÜCREYİ FORMATLAMAK İSTERSEN
 // CALISMA_SAYFASI.CELLS[1,1]..NumberFormat := '0,000'; ŞEKLİNDE YAPABİLİRSİN

 CALISMA_SAYFASI.CELLS[1,1]:='20';
 // BİRİNCİ SATIR VE BİRİNCİ SUTUN YANİ A1 HÜCRESİNE RAKAMI YAZDIK.
 // İSTERSEN XSATIR, XSUTUN DİYE INTEGER DEĞİŞKEN TANIMLAYIP BURADA KULLANABİLİRSİN.

 CALISMA_SAYFASI.CELLS[1,2]:='100';
 //İKİNCİ SÜTÜNUN İLK SATIRINA 100 DEĞERİNİ AKTARDIM.

 EXCEL.Range['C1', 'C1'].Formula := '=Sum(A1:B1)';
 // BELİRTİLEN HÜCREYE TOPLAMA FORMULÜ ATADIM.
 // BURADA EXCEL.RANGE YERİNE CELL DE KULLANABİLİRSİN
 // DAHA ANLAŞILIR OLSUN DİYE C1 ŞEKLİNDE YAZDIM.
 // DİLERSEN EXCEL.RANDGE[XSATIR,XSUTUN] ŞEKLİNDE KULLANABİLİSİN

 FINALLY
 EXCEL.VISIBLE  :=TRUE;
 END;

END;


Hücredeki T harfi nereden geliyor  soruna cevap.. Hücre biçimlendirmeden.

f7aMLC.png

Cvp: DBGrid den Excel Aktarımı - emozgun - 16-05-2021 

 While not DBGDataset.EOF do begin
   Sheet.Columns[2]. NumberFormat := '@';
   Sheet.Columns[5]. NumberFormat := '########';
   Sheet.Columns[9]. NumberFormat := '#.00';
 
   for S := 0 to DBG.Columns.Count-1 do
   Excel.Cells[Row,Col+S].Value := DBG.Columns[S].Field.Value;
 
DBGDataset.Next;
   inc(Row);
 end;
yerine 
Screen.Cursor:=crHourGlass;
Application.ProcessMessages;
DBGDataset.DisableControls;
While not DBGDataset.EOF do begin
  Sheet.Columns[2]. NumberFormat := '@';
  Sheet.Columns[5]. NumberFormat := '########';
  Sheet.Columns[9]. NumberFormat := '#.00';

  for S := 0 to DBGDataset.Fields.Count-1 do
  Excel.Cells[Row,Col+S].Value := DBGDataset.Fields[S].Value;

DBGDataset.Next;
  inc(Row);
end;
DBGDataset.EnableControls;

Screen.Cursor:=crDefault;
yazarsan hem dbgrid yerine dataset kullanıldığı için hızlanır hem de imleç üzerinden daha profesyonel görünür.

Cvp: DBGrid den Excel Aktarımı - OZCANK - 16-05-2021

(16-05-2021, Saat: 14:17)emozgun Adlı Kullanıcıdan Alıntı: 
 While not DBGDataset.EOF do begin
   Sheet.Columns[2]. NumberFormat := '@';
   Sheet.Columns[5]. NumberFormat := '########';
   Sheet.Columns[9]. NumberFormat := '#.00';
 
   for S := 0 to DBG.Columns.Count-1 do
   Excel.Cells[Row,Col+S].Value := DBG.Columns[S].Field.Value;
 
DBGDataset.Next;
   inc(Row);
 end;
yerine 
Screen.Cursor:=crHourGlass;
Application.ProcessMessages;
DBGDataset.DisableControls;
While not DBGDataset.EOF do begin
  Sheet.Columns[2]. NumberFormat := '@';
  Sheet.Columns[5]. NumberFormat := '########';
  Sheet.Columns[9]. NumberFormat := '#.00';

  for S := 0 to DBGDataset.Fields.Count-1 do
  Excel.Cells[Row,Col+S].Value := DBGDataset.Fields[S].Value;

DBGDataset.Next;
  inc(Row);
end;
DBGDataset.EnableControls;

Screen.Cursor:=crDefault;
yazarsan hem dbgrid yerine dataset kullanıldığı için hızlanır hem de imleç üzerinden daha profesyonel görünür.

Üstadım emeğine yüreğine sağlık çok teşekkür ederim. Birde bu bloğa "Lütfen Bekleyiniz" nasıl ekleyebilirim? Veri çok olunca bekletiyor.

Cvp: DBGrid den Excel Aktarımı - emozgun - 16-05-2021


  1. Formun ortasına bir tane Panel koyun. Ör: Panel3
  2. Panel'in Caption'ını Lütfen Bekleyiniz yapın
  3. Sağ tıklayıp Control - Send to Back (şart değil, gerekirse)
  4. FormCreate içine 
    Panel3.SendToBack;
  5. DBGridToExcell başına 
    Panel3.BringToFront;
Application.ProcessMessages;
  6. sonuna 
    Panel3.SendToBack;
Application.ProcessMessages;


Cvp: DBGrid den Excel Aktarımı - OZCANK - 17-05-2021

Arkadaşlar, Aynı Excel dosyası var ise  "Evet" , "Hayır" ve "Iptal" sorguluyor "Hayır" dediğim zaman alttaki hatayı veriyor kontrolünü nasıl sağlarım ?  
WorkBook.SaveAs(FileName);

Debugger Exception Notification
---------------------------
Project MENU.exe raised exception class EOleException with message 'Workbook sınıfının SaveAs yöntemi başarısız'. Process stopped. Use Step or Run to continue.


Fonksiyon yapmaya çalıştım olmadı.

Function ExcelSaveAs(Excel : Variant; FileName : String): Boolean;
Begin
 Result := True;
 try
     //WorkBook.
    Excel.SaveAs(FileName);
 except
   MessageDlg('Unable to locate '+FileName, mtError, [mbOK], 0);
   Result := False;
 end;
End;