Soru Excelde bir butonla çalışma sayfasını kaydedebilecegim bir ekranın açılmasını sağlamak

[Gkhnozn]

Merhabalar, şöyle bir şey yapmak istiyorum. Acaba mümkün müdür?
Bir butona tıkladığımda belirlediğim bir çalışma sayfasını kaydedip isim verebileceğim bir ekranın açılması ve istediğim yere istediğim isimle Excel çalışma sayfasini kaydetmek.

Sanki normal excel dosyasinda dosyadan farklı kaydet diyerek kaydetmek gibi.

Yardımcı olabilirseniz sevinirim. Iyi akşamlar dilerim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu kendi dosyanıza uyarlarsınız.

Ben aktif olan sayfayı excel dosyası kaydedecek şekilde ayarladım. Siz gerekiyorsa sayfa adı belirterek düzenleme yapabilirsiniz.

Option Explicit

Sub ActiveSheet_SavaAs()
    Dim File_Name As String, My_Folder As Variant
    
    File_Name = InputBox("Dosya adını giriniz...", "DOSYA ADI")
    
    If File_Name = "" Then
        MsgBox "İşleme devam edebilmeniz için dosya adı girmelisiniz!", vbCritical
        Exit Sub
    End If
    
    Set My_Folder = CreateObject("Shell.Application").BrowseForFolder(0, _
                    "Sayfayı kaydetmek istediğiniz klasörü seçiniz...", 50, &H0)
                    
    If Not My_Folder Is Nothing Then
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs My_Folder.Self.Path & "\" & File_Name & ".xlsx", xlOpenXMLWorkbook, Local:=True
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        MsgBox "Aktif sayfanız seçtiğiniz klasöre aşağıdaki isimle excel dosyası olarak kayıt edilmiştir." & _
               vbCrLf & vbCrLf & My_Folder.Self.Path & "\" & File_Name & ".xlsx", vbInformation
        Set My_Folder = Nothing
    Else
        MsgBox "Klasör seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

 

[Gkhnozn]

Istediğim sayfayı kaydetmek istersem, örneğin sayfa adı MALZEME olsa ActiveWorksheet kelimesini gördüğüm her yeri Worksheets("MALZEME") olarak değiştirmem yeterli olacaktır değil mi?

 

[Gkhnozn]

Hocam çok güzel çalıştı elinize sağlık, fakat bir problemle karşılaşıyorum. Örneğin varolan bir dosya ile ayni ismi kullanmış isem kod hata veriyor. Bunu engellemek için ne yapabilirim?
Aynı isim ile dosya kaydetmek istediğimde bir uyari mesaji verip tekrar isim ekranınin gelmesini ve farkli bir isim vererek ok dedikten sonra tekrar kaydedecegim yeri secmeden kayit yapılabilir mi?

Aynı şekilde ust uste bir kaç ayni isim verildiğinde bu işlemi tekrarlarsa çok güzel olur.

Yardımcı olabilirseniz sevinirim.

 

[Korhan Ayhan]

Aynı dosya isminde kod sorgususuz sualsiz kayıt yapması gerekir. Bunu denemiştim. Hatta şimdi tekrar denedim. Sorgusuz sualsiz aynı isim verdiğimde üst üste kayıt ediyor.

 

[Gkhnozn]

Hocam bende hata veriyor ya, isim aynı olamaz diye

 

[Korhan Ayhan]

İlginç..

Neyse aşağıdaki kodu deneyiniz. Kodun içinde aşağıdaki koyu satır ile sayfa tanımlaması yapabilirsiniz.

Set My_Sheet = Sheets("Sheet1")

Option Explicit

Sub My_Sheet_SaveAs()
    Dim File_Name As String, My_Folder As Variant
    Dim My_Sheet As Worksheet, My_Check As Boolean, My_Count As Byte
    
10  If My_Count = 3 Then
        MsgBox "Çok fazla deneme yaptınız!" & vbCrLf & vbCrLf & _
               "Lütfen daha sonra tekrar deneyiniz.", vbExclamation
        Exit Sub
    End If
    
    File_Name = InputBox("Dosya adını giriniz...", "DOSYA ADI")
    
    If File_Name = "" Then
        MsgBox "İşleme devam edebilmeniz için dosya adı girmelisiniz!", vbCritical
        Exit Sub
    End If
    
    If My_Check = False Then
        Set My_Folder = CreateObject("Shell.Application").BrowseForFolder(0, _
                        "Sayfayı kaydetmek istediğiniz klasörü seçiniz...", &H100)
    End If
                    
    If Not My_Folder Is Nothing Then
        If Dir(My_Folder.Self.Path & "\" & File_Name & ".xlsx") <> "" Then
            MsgBox "İlgili klasörde aynı isimle bir dosya zaten bulunuyor!" & vbCrLf & vbCrLf & _
                   "Lütfen farklı dosya adı giriniz!", vbCritical
            My_Check = True
            My_Count = My_Count + 1
            GoTo 10
        End If
        
        Set My_Sheet = Sheets("Sheet1")
    
        Application.ScreenUpdating = False
        My_Sheet.Copy
        ActiveWorkbook.SaveAs My_Folder.Self.Path & "\" & File_Name & ".xlsx", xlOpenXMLWorkbook, Local:=True
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
        
        MsgBox "Aktif sayfanız seçtiğiniz klasöre aşağıdaki isimle excel dosyası olarak kayıt edilmiştir." & _
               vbCrLf & vbCrLf & My_Folder.Self.Path & "\" & File_Name & ".xlsx", vbInformation
        
        Set My_Sheet = Nothing
        Set My_Folder = Nothing
    Else
        MsgBox "Klasör seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

 

[Gkhnozn]

Harikasınız, çok teşekkür ederim.

 

[Gkhnozn]

Hocam merhabalar, kodu işyerimdeki pc de deneyince şöyle bir durum ile karşılaştım. İşyerinde masaüstüne veri kaydı yapilamiyor ve sizin verdiğiniz kodda masaüstü tanimli geliyor ve buda her seferinde masaüstüne kayit yapamayacagima dair uyarı almama neden oluyor. Masaüstü yerine istediğim bir klasörü tanımlama gibi bir seçeneğim olabilir mi acaba?

 

[Korhan Ayhan]

Bir yanlışlık olmalı. Kodda masaüstü ile ilgili bir tanımlama yoktur. Sadece size klasör seçmenize yarayan pencere açılır. Bu pencerede masaüstü seçeneği var. Ama siz oradan dilediğiniz klasörü seçerek işleme devam edebilirsiniz.

 

[Gkhnozn]

Evet dediğiniz gibi ama açılan sayfanın en alt bölümünde Klasör diye bir bölümde Masaüstü yaziyor ve bundan ötürü hata aliyorum.

 

[Korhan Ayhan]

Tamam işte orada klasör seçmenizi bekliyor. Siz o menüden dilediğini klasörü seçerek işleme devam edebilirsiniz.

 

[Gkhnozn]

Dosya Kaydet Hocam bahsettiğim şey ile ilgili resim çektim ama nasıl size göstereceğim bilemiyorum. Bir mail vs varsa atabilirim.

 

[Korhan Ayhan]

Link erişime açık değil..

 

[Gkhnozn]

Açtım kusura bakmayın.

 

[Korhan Ayhan]

Bende de aynı şekilde çıkıyor. Sonra o ekranda masaüstü dışında bir klasör seçimi yaparsanız derin düzelecektir.

 

[Gkhnozn]

Evet ama ben daha klasör secimi yapmadan masaüstüne kayit yapamazsiniz diye uyari veriyor ve ben tamam diyerek o seçimi yapiyorum. Benim istediğim ise orada masaüstü değilde benim belirleyebilecegim bir klasör adi olsun ya da o bölüm hiç olmasın

 

[Korhan Ayhan]

#7 nolu mesajımdaki küçük bir güncelleme yaptım. Son halini deneyiniz. Yine olmazsa başka bir yöntem deneriz.

 

[Gkhnozn]

Halloldu hocam cok teşekkür ederim.