rapor oluşturmak

[yesimgurol]

Umarım anlatabilmişimdir,Sayın Necdet Bey. Ekte bulunan "Liste" isimli çalışma kitabında konu ile ilgili açıklama yapmaya çalıştım.

 

[yesimgurol]

Bu konu hakkında yardımcı olabilirmisiniz?

 

[yesimgurol]

Olmuyor sanırım..:-(

 

[yesimgurol]

Bu konu hakkında yardımcı olabilirmisiniz?

 

[yesimgurol]

Bu konu hakkında yardımcı olabilirmisiniz?

 

[yesimgurol]

Sayın Necdet Bey;bu konu hakkındaki düşüncenizi merak ediyorum.Böyle birşey yapmak mümkün müdür?

 

[Necdet]

Sayın Necdet Bey;bu konu hakkındaki düşüncenizi merak ediyorum.Böyle birşey yapmak mümkün müdür?

Merhaba,

Rapor dosyası diyorsunuz ama bambaşka bir isimle bir dosya ekliyorsunuz.

Bilgisiyar dilinde "A" başkadır "a" başka.

Yine Rapor dosyasında bir sürü veri var, insan o verileri görünce korkuyor. O veriler hakkında bilgi vermiorsunuz. Kısaca işin içine girince bu olay bitmeyecek gibi geliyor çünkü ne istediğiniz pek anlaşılmıyor.

Belki o yüzden kimse yanıt vermedi.

Bende dahil olmak üzere

 

[yesimgurol]

Sorunumu anlatma problemim var...Daha anlaşılır biçimde dosya hazırlamaya başlayayım.Sanırım benim konu başlığımda Farklı kaydet adıyla açmam gerekecek.Teşekkür ederim açıklamanız için.İyi çalışmalar,Necdet Bey.

 

[mancubus]

ekteki dosya iş görür zannediyorum.

Sub ProtokolUret()

Dim kitaba As Workbook, kitaptan As Workbook
Dim i As Integer, ssat As Integer
Dim yol As String, dosyaAdı As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Set kitaptan = ThisWorkbook
yol = ThisWorkbook.Path
ssat = kitaptan.Worksheets("Sayfa1").Cells(Rows.Count, "B").End(xlUp).Row

On Error Resume Next

For i = 4 To ssat
    Set kitaba = Workbooks.Open(yol & "\" & "ÇOCUK RAPOR FORMATI.xls")
    With kitaba
        .Worksheets("SONUÇ HESAP").Range("B6").Value = kitaptan.Worksheets("Sayfa1").Range("B" & i).Value
        .Worksheets("SONUÇ HESAP").Range("B7").Value = kitaptan.Worksheets("Sayfa1").Range("C" & i).Value
        .Worksheets("SONUÇ HESAP").Range("B8").Value = kitaptan.Worksheets("Sayfa1").Range("E" & i).Value
        .Worksheets("SONUÇ HESAP").Range("B9").Value = kitaptan.Worksheets("Sayfa1").Range("D" & i).Value
        .Worksheets("SONUÇ HESAP").Range("D6").Value = kitaptan.Worksheets("Sayfa1").Range("H" & i).Value
        .Worksheets("SONUÇ HESAP").Range("D8").Value = kitaptan.Worksheets("Sayfa1").Range("F" & i).Value
        .Worksheets("SONUÇ HESAP").Range("D9").Value = kitaptan.Worksheets("Sayfa1").Range("G" & i).Value
        dosyaAdı = .Worksheets("SONUÇ HESAP").Range("B6").Value
        .SaveAs yol & "\" & dosyaAdı, 56
        .Close
    End With
Next

On Error GoTo 0

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

 

[yesimgurol]

Sayın Mancubus; ilginize teşekkür ederim.Dosyanıza baktım anlayamadığım ben listeye bilgi girdiğimde bunları tekrardan nereye kaydediyor.Bulamadım:-(

 

[yesimgurol]

Kusura bakmayın şimdi tekrar baktım oldu.Çook teşekkür ederim.Tam istediğim gibi olmuş.İnanın harika...

 

[yesimgurol]

Sayın Mancubus; son bir ricam olsa sizden? Herşey çok güzel tek istediğim, yaş kısmında 18 den küçük olanların çocuk rapor formatını kullanması ki,şu an o şekilde burada sorun yok. Yalnız listedeki yaş kısmının 18 den büyük olması durumunda çocuk rapor formatını değilde yetişkin rapor formatını kullanmasını istiyorum.İnanın çok mutlu ettiniz beni çok işime yarayacak bir durum söz konusu çünkü..son ricamı da yapabilme durumunuz var mı?

 

[yesimgurol]

Yetişkin rapor formatını da eklediğim dosyayı şimdi ekledim.

 

[mancubus]

o dosyanın da aynı formatta olduğu düşünülür ise, şöyle revize edilebilir:

şablon dosya isimleri: (hepsi liste.xlsm ile aynı klasördeler)
ÇOCUK RAPOR FORMATI.xls
YETİŞKİN RAPOR FORMATI.xls


şunu unutmayalım:
bu kod liste dosyasına tüm bilgiler girildikten sonra çalıştırılır.
kod bir defa çalıştıktan sonra liste dosyasına yeni bilgiler girilecekse, eski protokol bilgileri silinerek 4. satırdan başlayarak girilir ve kod tekrar çalıştırılır.

bu canlı bir liste, sadece yeni girilenler için ilave dosya üretsin durumu var ise farklı bir çalışma gerekir.

ya da bir ana liste sayfası olur, bir de dosya yapılacaklar sayfası. yeni girişleri 4. satırdan başlayarak kopyalanır ve kod çalıştırılır. ki, bu iyi bir yöntem bence.

Sub Protokol_Uret()

Dim kitaba As Workbook, kitaptan As Workbook
Dim i As Integer, ssat As Integer
Dim yol As String, dosyaAdı As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Set kitaptan = ThisWorkbook
yol = ThisWorkbook.Path
ssat = kitaptan.Worksheets("Sayfa1").Cells(Rows.Count, "B").End(xlUp).Row

On Error Resume Next

For i = 4 To ssat
    With kitaptan.Worksheets("Sayfa1")
[COLOR="Red"]        If .Range("D" & i).Value <= 18 Then
            Set kitaba = Workbooks.Open(yol & "\" & "ÇOCUK RAPOR FORMATI.xls")
        Else
            Set kitaba = Workbooks.Open(yol & "\" & "YETİŞKİN RAPOR FORMATI.xls")
        End If
[/COLOR]        kitaba.Worksheets("SONUÇ HESAP").Range("B6").Value = .Range("B" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("B7").Value = .Range("C" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("B8").Value = .Range("E" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("B9").Value = .Range("D" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("D6").Value = .Range("H" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("D8").Value = .Range("F" & i).Value
        kitaba.Worksheets("SONUÇ HESAP").Range("D9").Value = .Range("G" & i).Value
        dosyaAdı = kitaba.Worksheets("SONUÇ HESAP").Range("B6").Value
        kitaba.SaveAs yol & "\" & dosyaAdı, 56
        kitaba.Close
    End With
Next

On Error GoTo 0

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

 

[yesimgurol]

Sayın Mancubus; açıklamalarınızı okudum.Son yazdığınız cümle ile hemfikirim.Zaten şu an ki kodlar çok iyi,istediğim gibi oldu sayenizde.Yalnız son kodlarınızı aldım güncelledim fakat 18 den küçükler için rapor çocuk formatı kullanılıyor istediğim gibi.Fakat 18 den büyükler için yetişkin rapor formatı kullanılmadı.Ben mi yanlış yaptım acaba:-(

18 den büyükler için yetişkin rapor formatı kullanılması gerek çünkü hasta sonucundaki referans değerleri farklı o açıdan önemli benim için.

 

[mancubus]

aynı klasörde YETİŞKİN RAPOR FORMATI.xls isimli bir dosya var mı?

ben kendim oluşturarak denedim. sorunsuz çalıştı.

 

[yesimgurol]

Sayın Mancubus; ekteki dosyada ben güncelledim ama yapamadım sanırım.Kontrol etmenizi rica etsem.Kusura bakmayın meşgul ediyorum sizi sizide...

 

[mancubus]

çalışmaz.
çünkü klasörde YETİŞKİN RAPOR FORMATI.xls isimli bir dosya yok.
YETİŞKİN RAPOR FORMATI.xls isimli bir dosya var. yani YETİŞKİN ve RAPOR kelimeleri arasında 1 değil 2 tane boşluk var.
dosyanın adı düzeltilmeli.
klasördeki dosya ismi ile koddaki dosya ismi aynı olmalı.

 

[yesimgurol]

Sayın Mancubus; size ve bu site kurucularına ne kadar TEŞEKKÜR etsem azdır.Çok ama çok mutlu oldum.Tam istemiş olduğum bir çözüm buldunuz sorunuma, size de ayrı yeten çok TEŞEKKÜR ederim.İyi çalışmalar

 

[mancubus]

rica ederim.

kolay gelsin.