Crystal Reports 8.5 to Excel.5.0 Workbook unun Makrolar ile Formatlanması

lsuersoy · 22 Kasım 2006

Merhaba arkadaslar ; Crystal Reports ile gelistirilmis bir Raporun EXCEL.5.0 formatinda Excel dosyasina aktarilmesi durumunda bicimsel olarak veriler daginik gelmektedir...

Benim amacım daginik veriler iceren bu EXCEL sayfasini makrolar vasitasi ile bicimlendirmektir.

Bicimlendirmenin en buyuk sorunu CR dan EXcel e akratilan raporun Satirsayisinin gun hergun 5-6 satir artmasidir.bunun sebebi hergun portfoye yeni musteriler eklenmesidir...

1-Oyle bir makro yazmaliyim ki....Sabit 26 sutun, dinamik N satir daki hucrelere (icerisinde veri olan tüm hucrelerin) kenarlık cizgisi eklesin...Yani burada ROWS sayisi sabit degil Colums sayisi 26..
2-A4-e yatay olarak bicimlendirilmis (1 nolu sorunu cozdukten sonra) verinin ZEBRA olarak dolgulandirilmasi gerekiyor...Yani veri basliginin 1.ci satirda oldugunu sayacak olursak....2.ci satir KOYU SARI , 3.satir BEYAZ , 4.cü Satir Koyu Sari , 5.ci satir BEYAZ.....vs..vs...Boyle yaklasik olarak 5000 satiri zebralandirmam gerekiyor...

Bu sorulari hazirlamadan once , kendi basima ve YURTTAS arkadasimizin da katkilari ile yazdigim kodları sizlerle paylasmak istiyorum...

Bu kodlara neden gerek duydum....CR to EXCEL veriler arasinda 2-3 satir ve 1-2 sutun bosluk birakarak aktariyor...Bu bosluklari her defasinda silmekten usandim...yazmis oldugum basit makrolar yerine ; "Application.ScreenUpdating = True " içermeyen makrolar yazmak istedim...Yani Ekrandaki mouse olay tiklamalari yada klavye ekran hareketlerinin olmadigi yeni makrolar duzenlemek isityorum...daha profosyonelce....

Bosluk silmek icin

Sub Bossatirsil()
Rows("1:1").Select
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For k = LastRow To 1 Step -1
If Cells(k, 1) = "" Then Rows(k).Delete
Next k
End Sub

Sub Bossutunsil()
Rows("1:1").Select
LastColumn = ActiveSheet.UsedRange.Column - 1 + _
ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For k = LastColumn To 1 Step -1
If Cells(1, k) = "" Then Columns(k).Delete
Next k
End Sub

Sub Ch_Arabaslik_Sil()
Rows("1:1").Select
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For k = LastRow To 1 Step -1
If Cells(k, 1) = "C/H KOD" Then Rows(k).Delete
Next k
End Sub

Silinen Basliginda Yeniden duzenlenmesi icin
Sub HTC_Baslik_Yaz()
Application.ScreenUpdating = False
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "C/H_Kodu"
Range("B1").Select
ActiveCell.FormulaR1C1 = "C/H_Ünvanı"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Bakiye_86"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Bakiye_87"
Range("E1").Select
ActiveCell.FormulaR1C1 = "YTL"
Range("F1").Select
ActiveCell.FormulaR1C1 = "USD"
Range("G1").Select
ActiveCell.FormulaR1C1 = "EUR"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Kapamasi_Yapilmamis_Borc"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Kapamasi_Yapilmamis_Alacak"
Range("J1").Select
ActiveCell.FormulaR1C1 = "C/H_Bakiyesi"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Faturalanmamis_irsaliyeler"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Top.ACIK.Bakiye"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Vadesi.Gelmemis.Cek-Senet"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Top.Risk"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Bekleyen_Siparisleri"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Karsiliksiz.C/S.iadesi"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Karsiliksiz.C/S.Bakiye"
Range("R1").Select
ActiveCell.FormulaR1C1 = "Kapanmamis.Pesin.FTR.lari"
Range("S1").Select
ActiveCell.FormulaR1C1 = "Net_Ciro"
Range("T1").Select
ActiveCell.FormulaR1C1 = "Odeme.Perf.GUN"
Range("U1").Select
ActiveCell.FormulaR1C1 = "iadeler.Tut"
Range("V1").Select
ActiveCell.FormulaR1C1 = "iade.Orani"
Range("W1").Select
ActiveCell.FormulaR1C1 = "Tahsilat/SatisFTR_orani"
Application.ScreenUpdating = False
End Sub

Bu arada CR ile sadece gorsel ve verisel baglari yakalayip , profosyonel yazilimciya iletip , gelen yonlendirmeler ile guncellemeler yapabiliyorum...CR konusunda profosyonel degilim..Ama egitimine katilmistim...Bu yazıma bakarak bana CR ile ilgili sorular sormamanizi oneririm...

Asil sorumu hatirlatayim.

1-Oyle bir makro yazmaliyim ki....Sabit 26 sutun, dinamik N satir daki hucrelere (icerisinde veri olan tüm hucrelerin) kenarlık cizgisi eklesin...Yani burada ROWS sayisi sabit degil Colums sayisi 26..
2-A4-e yatay olarak bicimlendirilmis (1 nolu sorunu cozdukten sonra) verinin ZEBRA olarak dolgulandirilmasi gerekiyor...Yani veri basliginin 1.ci satirda oldugunu sayacak olursak....2.ci satir KOYU SARI , 3.satir BEYAZ , 4.cü Satir Koyu Sari , 5.ci satir BEYAZ.....vs..vs...Boyle yaklasik olarak 5000 satiri zebralandirmam gerekiyor...

ilginize , simdiden tesekkur ederim...
Herkese iyi calismalar,

alibal · 22 Kasım 2006

Örnek dosya gönderebilirmisiniz..

lsuersoy · 22 Kasım 2006

alibal' Alıntı:
Örnek dosya gönderebilirmisiniz..

Tabiki gönderebilirim , Orginal datadaki Cari Hesap isimlerini silerek göndereceğim.
PERSONAL.XLS deki makrolari , Calisma Kitabina kayıt edip göndereceğim.
Gönderdiğim makrolar doğal olarak sadece gönderdiğim dosyada çalışacak...daha sonra sizde kendi PERSONAL.XLS nize kopyalarsınız...

alibal · 22 Kasım 2006

Teşekkürler, Bekliyoruz...

lsuersoy · 22 Kasım 2006

Dosya ektedir.

alibal' Alıntı:
Teşekkürler, Bekliyoruz...

Dosya Ektedir...

iyi calismalar ,

alibal · 23 Kasım 2006

Sayın Isuersoy;

Kendi kullandığım zebra renklendirmesi kodlarını gönderdim.

Kod:

Sub Sat&#305;rRenklendir()
Worksheets("Veri Taban&#305;").Activate              
Application.ScreenUpdating = False               '[B]- 1 -[/B]
Range(Cells(8, "B"), Cells(507, "AB")).Select  
Selection.Interior.ColorIndex = xlNone           '[B]- 2 -[/B]
For i = 8 To Cells(5, "A") + 8 Step 2            '[B]- 3 -[/B]
    Range(Cells(i, "B"), Cells(i, "AB")).Select '[B]- 4 -[/B]
    With Selection.Interior
        .ColorIndex = 34                         '[B]- 5 -[/B]
        .Pattern = xlSolid
    End With
Next
Range("E8").Select
End Sub

Bu kodlarda sırasıyla şu işlemler oluyor;
1- Ekran yinelemesi kesinlikle FALSE olmalı. Aksi halde 5000 kayıt için aşırı gecikme olur.
2- Seçili olan bölgedeki renlendirme ilk önce iptal ediliyor.
3- Renklendirme dögüsü başlıyor. Burada Döngü en son satırdan itibaren başlıyor. Ben bu en son satırı şu şekilde belirledim. En son toplam kayıt sayısını Cells(5, "A") hücresine aktarıyorum ve döngüyü bu değerden itibaren azaltarak ilk kayda kadar döndürüyorum. Buraya (Cells(5, "A") yerine) istersen sabit bir sayı da yazabilirsin.
4- Renklendirilecek olan satır seçiliyor.
5- Burada renk kodu var. 34 yerine sarı kodunu girmeniz gerek. 34=turkuaz

Diğer sorularınızıda gözden geçireyim gücüm yeterse onlarıda yazarım..

alibal · 23 Kasım 2006

Dolu olan satıra kadar kenarlık çizmek için ise; aşağıdaki kod kullanılabilir sanırım;

Kod:

Sub Ciz()
   '-------------  &#304;lk &#246;nce t&#252;m kenarl&#305;klar&#305; kald&#305;r -----------
    Range(Cells(1, 1), Cells(1000, 26)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'----------------------------------------------------------------
'------------ Kenarl&#305;klar&#305; &#199;iz-----------------------------
    Range(Cells(1, 1), Cells([A10000].End(3).Row, 26)).Select  ' *
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
End Sub

* 1. satırdan 10000. satırakadar tarama yapıp dolu olan en son 1. satırdan dolu olan en son satıra kadar olan 26 sütünu seçer.
Daha sonra aşağıdaki kodlarla çerçevelerini çizer.

Denemedim ama işe yarar.

lsuersoy · 24 Kasım 2006

Merhaba Alibal ;

"Satirrenklerdir" kodunu RUN ladığımda , "Subscript out of Range" hatası
"Ciz" kodunu RUN ladığımda , "Out of Stack Space" hatasını aldım.
Açıkcası bu hatalar ile ilk kez karşılaşıyorum.

"Range" ile "Cells" in seçim için içiçe kullanılma şeklini küçük bir örnek ile açıklayabilirmisin...Ben daha önce , sadece "range" veya sadece "Cells" kullandım...içiçe seçim için daha önce kullanmamıştım...

ilginize teşekkürler...

alibal · 24 Kasım 2006

Sayın Isuersoy
Dün yalnış kodları yapıştırdım. Kusura bakmayın. Yukarıya düzeltilmiş halini yapıştırdım. Kolay gelsin

lsuersoy · 24 Kasım 2006

tesekkurler,
Gondermis oldugunuz yeni "CiZ" kodu basarili bir sekilde calisti..
Fakat "Zebra" kodu calismiyor...bu konuda da yardimci olabilirmisiniz ?
kolay gelsin...

alibal · 24 Kasım 2006

Sayın Isuersoy;

Satır renklendirme kodunun uyarlanmış hali. denedim çalıştı.

Kod:

Sub SatırRenklendir()
Application.ScreenUpdating = False              
Range("AC1").Formula = "=COUNTIF(A2:A1000,"">"""""") + 1"
Range("B1", Cells([A10000].End(3).Row, 26)).Select
Selection.Interior.ColorIndex = xlNone         
For i = 2 To Range("AC1").Value Step 2   
    Range(Cells(i, "A"), Cells(i, "Z")).Select 
    With Selection.Interior
        .ColorIndex = 34                     
        .Pattern = xlSolid
    End With
Next
Range("B1").Select
End Sub

alibal · 24 Kasım 2006

Range sorunuzun cevabı ekte. Kolay gelsin...

lsuersoy · 24 Kasım 2006

Sayın Alibal ;

Son göndermiş olduğunuz kod da formula satırındaki syntax i komut, komut açıklayabilirmisiniz...

Range("AC1").Formula = "=COUNTIF(A2:A1000,"">"""""") + 1"
teşekürler,

lsuersoy · 24 Kasım 2006

End(3).Row ifadesindeki " parantez içinde 3 " neyi ifade ediyor...
Bu tür syntax ifadelerinin ne işe yaradığını ve örneklerin olduğu dökumanlar mevcut ise gönderebilirmisiniz...Çok yaralı bilgiler bunlar , Dikkat edecek olursanız syntax daki ifadelerin nasıl kullanılması gerektiği konusunda bilgi eksikliğim var...Bu bilgi eksikliğini ne kadar çok-çabuk kapatırsak o kadar yaratıcı düşünebiliriz....

ayrıntılı yardımlarınız için bir kez daha teşekkürü borç biliyorum...
kolay gelsin...

alibal · 24 Kasım 2006

Range("AC1").Formula = "=COUNTIF(A2:A1000,"">"""""") + 1"

Kodunda;

AC1 hücresine =EĞERSAY(A2:A1000;">""") + 1 fonsyonu atıyoruz.
COUNTIF........ ifadesi =EĞERSAY(A2:A1000;">""") + 1 fonksiyonunun MACRO ya dönüştürülmüş halidir. Anlamı ise A2 den A10000 e kadar olan sütünda dolu olan hücre sayısının 1 fazlasıdır. Size gönderdiğim kodda 1000 --> 10000 olacaktı eksik olmuş. 5000 kadar kayıttan söz etmiştiniz sanırım.
----------------------------------------------------------------------------

End.Row(3) ifadesi kalıp gibi bir şey. Bende tam olarak bilmiyorum.
Örnek: [A10000].End(3).Row ifadesinin işlevi A sütununun 10000. satırına kadar, dolu olan en son satır nosunu verir. mesela en san kayıt 250.satırda olsun. Ozaman malum ifadenin aldığı değer 250 olacaktır.
(3) ifadesini bende merak ediyorum. Yeni topik açarak sorabilirsiniz. Üstadlar cevaplar.