Çözüldü Kod Hiç Tepki Vermiyor.

Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Merhaba,
"Yesım" isimli çalışma kitabında "LİSTE" isimli sayfamda hastalarıma ait listem bulunmakla birlikte bu bilgilere göre raporlar oluşturmaktayım. Oluşturacağım rapor formatını Listedeki E sütununda yazan değere göre belirliyorum. Yani E sütununda NORMAL yazar ise bu hasta için NORMAL rapor taslağını kullanıyorum.

Aşağıda yer alan kodlarda bu listedeki E sütununda yazan değere göre ilgili rapor taslaklarımın olduğu klasörde ilgili rapor taslağına hastaların gerekli olan bilgilerini ilgili hücrelere aktarıp sonrasında belirlediğim hücre değerine göre kaydet yapıyor.

Kod: 
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("LİSTE").Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
For i = 2 To ssat
    With kitaptan.Worksheets("LİSTE")
    If .Range("E" & i).Value = "NORMAL" Then
        Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\NORMAL.xlsx")

   
           
    End If
       
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("J" & i).Value
        kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("K" & i).Value
        kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("L" & i).Value
        kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("M" & i).Value
        kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("N" & i).Value
        kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
        kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("H" & i).Value
        kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
       
     
       
       
        dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").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
Lakin başka bir bilgisayarda denediğimde kodu çalıştırdığımda hiç bir tepki vermiyor. Kodlar içerisine girip F8 ile kontrol ettiğimde de herhangi bir uyarı mesajı da vermiyor.:-(
 

Ekli dosyalar

Son düzenleme:
maliex

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
On Error Resume Next bunu pasif edip öyle adımlayın
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Öncelikle ilginiz için çok teşekkür ederim, Sayın maliex.
Denedim ve aşağıdaki uyarıyı alıyorum.
250428
 
maliex

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\NORMAL.xls")

dosya yolu hatalı
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Harikasınız Hocam, evet rapor taslağı dosya uzantısında .xls yazıyormuş onu .xlsx olarak düzeltince raporu oluşturdu ilgili klasöre kaydetti fakat bu sefer de aşağıdaki uyarıyı verdi:-(
250429
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Tamamdır hocam, hata benden kaynaklıymış yine:-(
Sorun çözüldü sayenizde tekrar teşekkür ederim. Saygılarımla.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Konu ile ilgili son bir ricam olsa:-(
Şöyle ki; 1 nolu mesajımda yer alan ve aşağıdaki kısımda E sütununda NORMAL yazar ise ilgili klasörde "NORMAL.xlsx " dosyası dikkate alınarak ilgili hücrelere değerleri alıp kaydediyor.

Kod: 
If .Range("E" & i).Value = "NORMAL" Then
        Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\NORMAL.xlsx")

  
          
    End If
      
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("J" & i).Value
        kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("K" & i).Value
        kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("L" & i).Value
        kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("M" & i).Value
        kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("N" & i).Value
        kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
        kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("H" & i).Value
        kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value

Bu işlemi hasta raporlamada kullanmaktayım. Haliyle başka başka rapor formatları kullanıyorum.(NORMAL, YETİŞKİN, ÇOCUK v.s.) Dolayısı ile rapor formatlarımdaki değerler hepsinde aynı yerlere atanmamakta. Bu açıdan acaba E sütununda YETİŞKİN yazarsa yine ilgili klasörden YETİŞKİN.xlsx dosyası seçilsin ve yukardaki gibi ben değerleri ilgili hücrelere atasam. En azından bir tane örnek olsa ben diğer rapor formatları için uyarlarım.
 
maliex

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
Kod: 
If .Range("E" & i).Value = "NORMAL" Then

        Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\NORMAL.xlsx")
    
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("J" & i).Value
        kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("K" & i).Value
        kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("L" & i).Value
        kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("M" & i).Value
        kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("N" & i).Value
        kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
        kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("H" & i).Value
        kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        
elseIf .Range("E" & i).Value = "cocuk" Then   

        Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\yetiskin.xlsx")
    
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("J" & i).Value
        kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("K" & i).Value
        kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("L" & i).Value
        kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("M" & i).Value
        kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("N" & i).Value
        kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
        kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("H" & i).Value
        kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
elseIf .Range("E" & i).Value = "yetiskin" Then   

        Set kitaba = Workbooks.Open("C:\Users\Yesım\Desktop\ooo" & "\yetiskin.xlsx")
    
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value
        kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("J" & i).Value
        kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("K" & i).Value
        kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("L" & i).Value
        kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("M" & i).Value
        kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("N" & i).Value
        kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
        kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("H" & i).Value
        kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
        kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("I" & i).Value

    End If
dosya yolları vehücre atamalarını kontrol ediniz
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
950
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Süpersiniz gerçekten Sayın maliex,
Çok teşekkür ederim ilginiz için. Saygılarımla.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst