XLSM dosyayı Aynı Klasöre xlsx olarak kaydetme

[walabi]

Merhaba,

Kullanmış olduğum bir VBA çalışmasının Veri adlı sayfasını aynı klasöre xlsx formatında kaydetmek istiyorum. Veri adlı excel sayfasında A1 hücresi Rapor başlığı, bu başlığı xlsx formatında kaydedilecek excel kitabının adı olarak belirleyerek kaydetmem gerekli. Bunu nasıl yapabilirim.

VBA dosyam haftalar itibari ile tanışarak kullanılacak ve bunun için ilgili vba çalışmasının olduğu klasöre diğer excelleri kaydetmek istiyorum.

 

[Biolightant]

Merhaba

Option Explicit

Sub MakrosuzSayfaKaydet()
'Biolight 2024 - Eppur Si Muove

    ' Dosya adını saklayacak bir değişken tanımlanıyor.
    Dim DosyaAD As String

    ' MsgBox için başlık, stil, mesaj ve kullanıcı cevabını saklayacak değişkenler
    Dim KaydetTitle As String
    Dim KaydetStyle As Integer
    Dim KaydetMsg As String
    Dim KaydetSor As Variant

    ' "Veri" sayfası seçiliyor ve A1 hücresindeki veri dosya adı olarak alınıyor.
    Sheets("Veri").Select
    DosyaAD = Range("A1").Value
    
    ' Dosya isminde kabul edilmeyen karakterler boşluk ile değiştiriliyor.
    DosyaAD = Replace(DosyaAD, "\", " ")
    DosyaAD = Replace(DosyaAD, "/", " ")
    DosyaAD = Replace(DosyaAD, ":", " ")
    DosyaAD = Replace(DosyaAD, "*", " ")
    DosyaAD = Replace(DosyaAD, "?", " ")
    DosyaAD = Replace(DosyaAD, """", " ")
    DosyaAD = Replace(DosyaAD, "<", " ")
    DosyaAD = Replace(DosyaAD, ">", " ")
    DosyaAD = Replace(DosyaAD, "|", " ")
    
    ' Dosya yolunu ve adını içeren tam dosya yolu oluşturuluyor.
    DosyaAD = ThisWorkbook.Path & "\" & DosyaAD & ".xlsx"
    
    ' Ekran güncellemesi geçici olarak kapatılıyor ve uyarı mesajları devre dışı bırakılıyor.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Aynı isimde dosya olup olmadığını kontrol ediyor.
    KaydetTitle = "[ " & Dir(DosyaAD) & " ]" & " Dosya zaten var"
    KaydetStyle = vbYesNo + vbQuestion + vbDefaultButton2
    KaydetMsg = "[ " & Dir(DosyaAD) & " ]" & " adlı bir dosya zaten var !" & vbCrLf & vbCrLf & "Değiştirmek istermisiniz.?"
    
    If Dir(DosyaAD) <> "" Then
        
        ' Kullanıcıya mevcut dosyanın üzerine yazmak isteyip istemediği soruluyor.
        KaydetSor = MsgBox(KaydetMsg, KaydetStyle, KaydetTitle)
        
        If KaydetSor = vbYes Then
            ' Kullanıcı "Evet" derse, dosya mevcut olanın üzerine kaydediliyor.
            Sheets("Veri").Copy
            ActiveWorkbook.SaveAs Filename:=DosyaAD, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close SaveChanges:=False
        Else
            ' Kullanıcı "Hayır" derse, işlem durduruluyor.
            MsgBox "Veriler Kayıt EDİLMEDİ...", vbInformation, "Veriler Kayıt Olmadı"
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            Exit Sub
        End If
    
    Else
        ' Dosya mevcut değilse, yeni dosya olarak kaydediliyor.
        Sheets("Veri").Copy
        ActiveWorkbook.SaveAs Filename:=DosyaAD, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=False
    End If
    
    ' Ekran güncellemesi ve uyarı mesajları yeniden etkinleştiriliyor.
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 

[Biolightant]

Merhaba,
Kodlar çok kalabalık geldi gözüme.

Kodların ana fikri

Sub AnaFikir()
    Dim DosyaAD As String
    DosyaAD = ThisWorkbook.Path & "\" & Worksheets("Veri").Range("A1").Value & ".xlsx"
    Sheets("Veri").Copy
    ActiveWorkbook.SaveAs Filename:=DosyaAD, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
End Sub

 

[walabi]

Merhaba,
Kodlar çok kalabalık geldi gözüme.

Kodların ana fikri

Sub AnaFikir()
    Dim DosyaAD As String
    DosyaAD = ThisWorkbook.Path & "\" & Worksheets("Veri").Range("A1").Value & ".xlsx"
    Sheets("Veri").Copy
    ActiveWorkbook.SaveAs Filename:=DosyaAD, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
End Sub

Merhaba,

Son kodlarınız benim için yeterli. Kısa ve basit. Destek için teşekkürler.