makro kodundaki xlsx i xlsm yapma

[euphrates55]

aşağıdaki kodu sağolsun Ömer BARAN yardımcı olarak bana yazdı. son bir sorum kaldı ama sanırım kendisi meşgul ve bir yerde değişikliğe ihtiyacım oldu. dosyam xlsx uzantılı kaydediliyor ve kaydedilen excelde KTF olduğu için xlsm olarak kaydetmesi gerekiyor. xlsx i xlsm olarak değiştirdiğimde
bir alt satırdaki

ActiveWorkbook.SaveAs belge

kısmı hata veriyor. bunu nasıl düzeltebilirim. tüm kod aşağıda...

Public bekle
Sub FARKLI_KAYDET_aks()
Set s = Sheets("akssunu")
bekle = "DUR"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For sat = 3 To 20
        s.[V3] = s.Cells(sat, "x")
        ActiveSheet.Copy
        belge = ThisWorkbook.Path & "\akslar\" & Replace(Replace(s.Cells(sat, "x").Value, ":", "="), "/", "&") & ".xlsx"
        ActiveWorkbook.SaveAs belge
        ActiveWorkbook.Close
    Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
bekle = ""
End Sub

 

[halit3]

 ActiveWorkbook.SaveAs belge, FileFormat:=52

Kırmızı bölümü ekle

 

[euphrates55]

 ActiveWorkbook.SaveAs belge, FileFormat:=52

Kırmızı bölümü ekle

teşekkürler. dediğinizi yapınca oldu. ama sorun bu değilmiş. benzersizbirleştir diye bir ktf kullanıyorum. ana tablomda module2 de bulunuyor. sayfayı dışarı kopyalayınca modul2 gelmediği için #ad hatası alıyorum. bu modülü de farklı kaydettiğim excel dosyasında bulunması için ilk mesajdaki kod a iliştirme şansımız oluyor mu. üzgünüm soru soruyu doğurdu

 

[halit3]

bu iki satırı yer değiştirin

ActiveSheet.Copy
belge = ThisWorkbook.Path & "\akslar\" & Replace(Replace(s.Cells(sat, "x").Value, ":", "="), "/", "&") & ".xlsx"

 

[euphrates55]

bu iki satırı yer değiştirin

ActiveSheet.Copy
belge = ThisWorkbook.Path & "\akslar\" & Replace(Replace(s.Cells(sat, "x").Value, ":", "="), "/", "&") & ".xlsx"

#ad? hatasına bir çözüm olmadı. bunla ilgili mi söylediniz yoksa genel mi?

 

[halit3]

örnek dosyanızı ekleyin bir bakalım

 

[euphrates55]

örnek dosyanızı ekleyin bir bakalım

sıkıntı olan akssunu sekmesindeki sarıya boyalı yerlerde noktalıbirleştir ve benzersizbirleştir fonksiyonlarının olması ve rapor çıkarta bastıktan sonra akslar klasörüne çıkan dosyalarda bu ktf lerin olmadığı için #ad? hatası veriyor olması. ben bunu bu ktf leri eklenti olarak kaydedip çözebiliyorum ama başka bilgisayar kullanıcılarının da bu hataya maruz kalmaması için kullanılan bu iki modülün sanırım çıkarılan excel dosyasına ekleniyor olması gerekiyor.

 

[Korhan Ayhan]

Merhaba,

Dosyayı kopyalayıp gereksiz sayfaları silerseniz makronuz dosyada duracaktır.

Ya da aşağıdaki prosedürü kodlarınıza adapte ediniz.

Kaynak; https://stackoverflow.com/questions...e-from-one-excel-workbook-to-another-workbook

Sub CopyModule()
    Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
    Set SourceVBProject = ThisWorkbook.VBProject
    Dim NewWb As Workbook
    Set NewWb = Workbooks.Add ' Or whatever workbook object you have for the destination
    Set DestinationVBProject = NewWb.VBProject
    '
    Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
    Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
    ' Add a new module to the destination project
    Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
    '
    With SourceModule
        DestinationModule.AddFromString .Lines(1, .CountOfLines)
    End With
End Sub

 

[euphrates55]

ana dosyamda yeni bir modüle de ekledim, akssunu sayfasına da ekledim ama sonuç alamadım. eğer ki ilk mesajdaki kodların arasına bir yere eklemem gerekiyorsa o beni aşıyor maalesef. cevap için teşekkürler.

 

[halit3]

Belkide kodları baybas etmek gerekiyor

Public bekle
Sub FARKLI_KAYDET_aks()
Set s = Sheets("akssunu")
bekle = "DUR"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For sat = 3 To 10
        s.[V3] = s.Cells(sat, "x")
        belge = ThisWorkbook.Path & "\akslar\" & Replace(Replace(s.Cells(sat, "x").Value, ":", "="), "/", "&") & ".xlsm"
        ActiveSheet.Copy

Dim X As Range
For Each X In [y3:al44]
If X.HasFormula = True Then
X.Value = X.Value
End If
Next X
        
        ActiveWorkbook.SaveAs belge, FileFormat:=52
        ActiveWorkbook.Close
    Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
bekle = ""
End Sub

 

[euphrates55]

bu kod ile çok yavaşladı ve maalesef yine olmadı. ilginiz için teşekkürler. daha fazla oyalamayayım sizi. o kadarını da elle yapalım artık.