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

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Export_ActiveSheet_No_Links()
    Dim File_Name As String, My_Folder As Variant
    Dim New_Workbook As Workbook
    Dim WS As Worksheet
    
    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
        Application.Calculation = xlCalculationManual
        
        ' Aktif sayfayı kopyala (yeni çalışma kitabı oluştur)
        ActiveSheet.Copy
        Set New_Workbook = ActiveWorkbook
        
        ' Yeni çalışma kitabındaki tüm sayfaları bağlantısız yap
        For Each WS In New_Workbook.Worksheets
            WS.UsedRange.Value = WS.UsedRange.Value
        Next
        
        ' Dosyayı kaydet
        New_Workbook.SaveAs My_Folder.Self.Path & "\" & File_Name & ".xlsx", xlOpenXMLWorkbook, Local:=True
        New_Workbook.Close False
        
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        
        MsgBox "Aktif sayfanız bağlantılar değerlere çevrilerek seçtiğiniz klasöre aşağıdaki isimle 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

 

[mkuru28]

Korhan hocam çok teşekkür ederim.