(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;
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;
(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.
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;
(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
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.
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.
(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.
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;
