Çözüldü Kaydet için dosya yolu belirleme hakkında.

Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Merhaba,
Forumda saygıdeğer üstatların yardımı ile oluşturmuş olduğumuz aşağıda yer alan kodlar sorunsuz çalışmakta, yalnız rutin işlerde kullanmaya başladıkça eksiklikler/eklemeler hasıl oluyor. Şöyle ki ; kullanılan kodun tamamı bu şekilde,

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("ÖZET LİSTE").Cells(Rows.Count, "B").End(xlUp).Row

For i = 2 To ssat
    With kitaptan.Worksheets("ÖZET LİSTE")
    If .Range("E" & i).Value = "NORMAL" Then
        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\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("L12").Value = .Range("O" & i).Value
        
        
        
       ElseIf .Range("E" & i).Value = "HOMOZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HOMOZİGOT.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("L12").Value = .Range("O" & i).Value
        
      
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
      
      
      
       ElseIf .Range("E" & i).Value = "HETEROZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HETEROZİGOT.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("L12").Value = .Range("O" & i).Value
        
        
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
      
      
       ElseIf .Range("E" & i).Value = "COMPOUND HETEROZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\COMPOUND HETEROZİGOT.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("L12").Value = .Range("O" & i).Value
        
        
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("A26").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("H23").Value = .Range("D" & i).Value
       kitaba.Worksheets("RAPOR").Range("D26").Value = .Range("D" & i).Value
      
      End If
          
        
      
  dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _
kitaba.Worksheets("RAPOR").Range("D9").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
Revize edilmesi gereken eylem ise ;


Kod: 
  dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _

kitaba.Worksheets("RAPOR").Range("D9").Value

        kitaba.SaveAs yol & "\" & dosyaAdı, 56

        kitaba.Close
Bu kısımda dosyalar oluşturulduktan sonra ilgili dosya ismine göre excel sayfasının olduğu klasöre kaydedilmektedir. Bu kısımda dosyaların kaydedileceği klasörü bana sormasını istiyorum. Yani kod çalışmaya başlayınca pencere açılsın ve ben kodun oluşturduğu dosyaların kaydedileceği klasörü seçebilme imkanım olmasını istemekteyim.
 
dEdE

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,598
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
Mevcut Kod bloğunuzu;
Kod: 
dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _

kitaba.Worksheets("RAPOR").Range("D9").Value

        kitaba.SaveAs yol & "\" & dosyaAdı, 56

        kitaba.Close
Aşağıdaki ile değiştirerek dener misiniz?

C++: 
dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _
kitaba.Worksheets("RAPOR").Range("D9").Value

Application.Dialogs(xlDialogSaveAs).Show dosyaAdı, 56

kitaba.Close
 
Son düzenleme:
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Sayın "dEdE" merhaba,
Öncelikle ilginiz için teşekkür ederim. Öneriniz doğrultusunda denedim, şöyle ki;
1- Evet oluşturulacak olan dosyanın kaydedileceği dosya yolu için istediğim şekilde pencere açılıyor. Fakat oluşturulan dosyanın ismi ;
Kod: 
dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _

kitaba.Worksheets("RAPOR").Range("D9").Value
Buradaki değerlere göre olması gerekirken açılan pencerede dosyayı kaydetmem için yeni bir isim yazmam gerekiyor:-(

2- Bu kodu hasta listemin olduğu, (ki listede 20-30 tane hastam olabiliyor) sayfada çalıştırıyorum. Önerinizdeki kodu çalıştırdığımda her hasta için oluşturulan çalışma sayfası için dosya yolu penceresi açılıyor:-(
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
Kodlarınızı baştan sona incelemedim.
Kodda ilk satırlarda yol değişkenini sizin seçtiğiniz dizini belirttim.
Kodlarınıza uyarlayınız. kodun hepsini buraya yazmayacağım, değişiklik yaptığım yere kadar ekledim.
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

DizinSec Yol

If Yol = "" Then End

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
.
.
.
Kod: 
Sub DizinSec(ByRef Yol As String)

Dim fd  As FileDialog

Set fd = Application.FileDialog(4)  '4 = msoFileDialogFolderPicker

With fd
    .ButtonName = "Seçiniz"
    .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
    .InitialView = msoFileDialogViewDetails
    .Title = "Bir Dizin Seçiniz"
    If .Show = -1 Then
        Yol = .SelectedItems(1) & Application.PathSeparator
    Else
        Yol = ""
        End
    End If
    
End With

End Sub
 
dEdE

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,598
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
1. Farklı kaydet penceresi açıldığında belirttiğiniz dosya adı yazılı olarak gelmesi gerekir. Dosya adı tanımlamasında bir sorun olabilir.
Application.Dialogs(xlDialogSaveAs).Show dosyaAdı satırından önce MsgBox dosyaAdı satırını ekleyerek istediğiniz dosya adını kontrol ediniz.
2. Kodlarınız her hasta için oluşturulan çalışma sayfası sonrası size sormadan belirtilen yol ile ilgili klasöre kayıt yapıyordu. Bana sor dediğimiz için Farklı Kaydet penceresini açıyor. Bu durumda çözüm, revize ettiğimiz kod bloğunu Protokol_Uret prosedürünün dışına taşımak olacaktır. Nereye taşınacağını kodların tamamını görmeden söylemek zor. Dosyayı kapatmadan önce çalışan prosedürün sonuna eklenebilir. Başka bir çözüm de Auto_Close prosedürü oluşturup kodları onun içine yazmak olabilir.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
dEdE' Alıntı:
Merhaba,
1. Farklı kaydet penceresi açıldığında belirttiğiniz dosya adı yazılı olarak gelmesi gerekir. Dosya adı tanımlamasında bir sorun olabilir.
Application.Dialogs(xlDialogSaveAs).Show dosyaAdı satırından önce MsgBox dosyaAdı satırını ekleyerek istediğiniz dosya adını kontrol ediniz.
2. Kodlarınız her hasta için oluşturulan çalışma sayfası sonrası size sormadan belirtilen yol ile ilgili klasöre kayıt yapıyordu. Bana sor dediğimiz için Farklı Kaydet penceresini açıyor. Bu durumda çözüm, revize ettiğimiz kod bloğunu Protokol_Uret prosedürünün dışına taşımak olacaktır. Nereye taşınacağını kodların tamamını görmeden söylemek zor. Dosyayı kapatmadan önce çalışan prosedürün sonuna eklenebilir. Başka bir çözüm de Auto_Close prosedürü oluşturup kodları onun içine yazmak olabilir.
Genişletmek için tıkla ...
Sayın dEdE, tekrar merhaba,
1. Maddede ki sorunum tamam tekrar demiş olduğunuz kodları yazınca sorun olmadı. (Dosya isimlerinde)
2. Bu madde için kısa bir açıklama yapmam gerekir ise;
oluşturulan excel sayfaları 1.nolu mesajımda yer alan kodları içeren excel sayfasının olduğu klasör içerisine kaydedilmekte.(20-30-40 adet olabiliyor)
İstediğim oluşturulan bu excel dosyalarının hepsi belirttiğim klasör içerisine kaydedilmesi.
Aslında sizin 2 nolu mesajınızda istediğim gibi dosya yolu seçmem için pencere açılıyor ama bu sefer de oluşturulan her bir excel dosyası için açılıyor. Bir defa istediğim klasörü seçsem oluşturulan her dosya o klasöre kaydedilse:-(
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Necdet' Alıntı:
Merhaba,
Kodlarınızı baştan sona incelemedim.
Kodda ilk satırlarda yol değişkenini sizin seçtiğiniz dizini belirttim.
Kodlarınıza uyarlayınız. kodun hepsini buraya yazmayacağım, değişiklik yaptığım yere kadar ekledim.
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

DizinSec Yol

If Yol = "" Then End

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
.
.
.
Kod: 
Sub DizinSec(ByRef Yol As String)

Dim fd  As FileDialog

Set fd = Application.FileDialog(4)  '4 = msoFileDialogFolderPicker

With fd
    .ButtonName = "Seçiniz"
    .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
    .InitialView = msoFileDialogViewDetails
    .Title = "Bir Dizin Seçiniz"
    If .Show = -1 Then
        Yol = .SelectedItems(1) & Application.PathSeparator
    Else
        Yol = ""
        End
    End If
   
End With

End Sub
Genişletmek için tıkla ...
Sayın Nejdet bey,
İlginiz için teşekkür ederim. Yalnız dediğiniz şekilde kodları revize ettim,
1- Evet dosya yolu için pencere açıldı klasörü seçtim fakat seçmiş olduğum klasör içerisine kaydedilmedi maalesef oluşturulan dosyalar:-(
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
yesimgurol' Alıntı:
Sayın Nejdet bey,
İlginiz için teşekkür ederim. Yalnız dediğiniz şekilde kodları revize ettim,
1- Evet dosya yolu için pencere açıldı klasörü seçtim fakat seçmiş olduğum klasör içerisine kaydedilmedi maalesef oluşturulan dosyalar:-(
Genişletmek için tıkla ...
Ben kodlarda sadece dizin seçmeyi belirttim, diğerlerini sizin düzenlemeniz gerekiyordu.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Necdet' Alıntı:
Ben kodlarda sadece dizin seçmeyi belirttim, diğerlerini sizin düzenlemeniz gerekiyordu.
Genişletmek için tıkla ...
Sayın Necdet bey,
Haklısınız kesinlikle meşgul etmek de istemiyorum aslında sizi :-(
Lakin,
4 nolu mesajınızdaki ilk kod bloğunu orjinal kodlarımdaki ilk kod bloğu ile değiştirdim , yine 4 nolu mesajınızdaki ikinci kodu da orjinal kodların bitimine ekledim (end sub sonrasına) ancak bu kadar düzenleyebiliyorum:-(
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Ben dizin belirleme kodlarında "\" zaten ekledim
Siz dosyayı saveas yaparken "\" silerseniz sanırım sonuca ulaşırsınız.

Kod: 
kitaba.Worksheets("RAPOR").Range("D9").Value
        kitaba.SaveAs yol & dosyaAdı, 56
        kitaba.Close
gibi.
Dediğim gibi kodları baştan sona incelemedim, dosya olmayınca zor oluyor kod incelemek.
Önerimi deneyip sonucu söylerseniz ben de merak ettim, bakalım çalışacak mı?
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Nejdet bey merhaba,

4 nolu mesajınızda belirtmiş olduğunuz kodları ve son mesajınızdaki öneriniz doğrultusunda düzenlemiş olduğum kodların son hali aşağıdaki şekilde oldu.
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

DizinSec Yol

If Yol = "" Then End

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

Set kitaptan = ThisWorkbook
Yol = ThisWorkbook.Path
ssat = kitaptan.Worksheets("ÖZET LİSTE").Cells(Rows.Count, "B").End(xlUp).Row

For i = 2 To ssat
    With kitaptan.Worksheets("ÖZET LİSTE")
    If .Range("E" & i).Value = "NORMAL" Then
        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\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("L12").Value = .Range("O" & i).Value
       
       
       
       ElseIf .Range("E" & i).Value = "HOMOZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HOMOZİGOT.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("L12").Value = .Range("O" & i).Value
       
     
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
     
     
     
       ElseIf .Range("E" & i).Value = "HETEROZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HETEROZİGOT.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("L12").Value = .Range("O" & i).Value
       
       
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
     
     
       ElseIf .Range("E" & i).Value = "COMPOUND HETEROZİGOT" Then

        Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\COMPOUND HETEROZİGOT.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("L12").Value = .Range("O" & i).Value
       
       
       kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("A26").Value = .Range("C" & i).Value
       kitaba.Worksheets("RAPOR").Range("H23").Value = .Range("D" & i).Value
       kitaba.Worksheets("RAPOR").Range("D26").Value = .Range("D" & i).Value
     
      End If
         
       
   

  dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value & "_" & _
kitaba.Worksheets("RAPOR").Range("D9").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
Kod: 
Sub DizinSec(ByRef Yol As String)

Dim fd  As FileDialog

Set fd = Application.FileDialog(4)  '4 = msoFileDialogFolderPicker

With fd
    .ButtonName = "Seçiniz"
    .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
    .InitialView = msoFileDialogViewDetails
    .Title = "Bir Dizin Seçiniz"
    If .Show = -1 Then
        Yol = .SelectedItems(1) & Application.PathSeparator
    Else
        Yol = ""
        End
    End If
   
End With

End Sub
Kodları çalıştırdığımda;
1- Oluşturulan dosyaların kaydedileceği dosyaların klasör seçimi için pencere açılıyor ve istediğim klasörü seçiyorum. (OLUŞTURULMUŞ RAPOR)
2- Fakat oluşturulan dosyalar seçtiğim klasör içerisine değil, masa üstüne geliyor.:-(
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Kodları F8 ile ilerleyerek yol değişkenin içeriğine bakabilirsiniz. Acaba masa üstünü seçmiş olabilir misiniz?
DizinBul da ilk değer olarak masaüstünü gösteriyor çünkü.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Nejdet bey,

Kod: 
.InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
Bu kısımda "Desktop" yazıyor ondan mı oluyor acaba (seçmiş olduğum klasör de masaüstünde yer alıyor)
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
masa üstünü doğrudan seçerseniz masaüstüne yazar, masa üstündeki dizini seçerseniz o dizin geçerli olur.
Ha bu arada adım Nejdet değil Necdet :)
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Necdet bey, çok pardon kusura bakmayın, dikkatimden kaçmış.:-(

Yapmış olduğum işlemi yazayım yanlış bir dosya yolu seçiyorum o zaman, şöyle ki;

1- Masa üstünde bir klasörüm olsun (A klasörü)
2- Kodu çalıştırıyorum. Oluşturulan dosyaların kaydedileceği pencere açılıyor.
3- Açılan pencereden 1.madde deki klasörü seçiyorum. (C:\Users\Yesım\Desktop\A)
4- Klasör seçimimden sonra kod çalışıyor.
5-Oluşturulan excel sayfaları seçmiş olduğum klasöre değil masaüstüne kaydediliyor.

Bu durumda nasıl bir yol izlemeliyim.:-( Oluşturulan dosyaların 3.madde deki klasöre kaydedilmesi için.
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,232
Excel Vers. ve Dili
Ofis 365 Türkçe
Yeşim hanım,
Masaüstündeki A klasörünü seçiyorsanız dosyaları da oraya kaydetmesi gerek.
Başka bir klasör seçin C ya da D sürücülerinde bir de öyle deneyin derim.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Necdet bey,
İlgi ve alakanız için çok teşekkür ederim gerçekten. Olmadı maalesef yine, ilk hali ile kullanıcam artık. Saygılarımı sunuyorum.
 
Y

yesimgurol

Altın Üye
Katılım
8 Aralık 2011
Mesajlar
942
Excel Vers. ve Dili
Excel 2016,32bit
Altın Üyelik Bitiş Tarihi
18-11-2024
Merhabalar,
Sayın Ersel bey'in önerisi doğrultusunda ;
1 nolu mesajımda yer alan kod içerisindeki ;yol = ThisWorkbook.Path bu kısım ;

Kod: 
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
Do While dlg.Show <> -1
MsgBox "Klasör seçilmedi."
Loop
yol = dlg.SelectedItems(1)
Kod bloğu ile değiştirilerek çözüm bulundu. Sayın "dEdE" ve "Necdet" hocam ilgileriniz için çok ama çok teşekkür ederim. Saygılarımı sunuyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst