2003 de çalışıp 2010 da çalışmayan makro

[djoguzz]

Herkese Merhaba,

Sub FARKLI_KAYDET()
Dim Dosya_Yolu, Dosya_Adı, ds
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Dosya_Adı = Sheets("PRO.HZ").Range("C7")
Dosya_Yolu = "\\Erguven01\C\KREDİ EVRAKLARI"
Set ds = CreateObject("Scripting.FileSystemObject")
X = Dosya_Yolu & "\" & Dosya_Adı
a = ds.FolderExists(X)
If a <> True Then
ds.CreateFolder X
End If

If Len(Dosya_Yolu) <= 3 Then Dosya_Yolu = Replace(Dosya_Yolu, "\", "")
Sheets(Array("PRO", "Kredi Değ.", "ÖZKAYNAK", "TRM.KRD", "KEFİL")).Copy
[COLOR="Red"]ActiveWorkbook.SaveAs Filename:="" & X & "\" & Dosya_Adı & " .xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
ActiveWorkbook.Close[/COLOR]
MsgBox Dosya_Yolu & "\" & Dosya_Adı & ".xls" & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

bu kod excel 2003 de çalışıyor ama excel 2010 da hata veriyor. debug diye uyarı veriyor tıkladığımda kırmızı ile işaretlidiğim satırda sarı işaret oluyor hata olduğu için. sorun nedir çözebilecek varmı acaba..

 

[djoguzz]

yokmu yapabilecek bi arkadaş ?

 

[Levent Menteşoğlu]

2010 versiyonunda makro kaydet ile "save as" işlemini yaparak gerekli kodları elde edebilirsiniz. Daha sonra bu kodları mesajınızdaki kırmızı renkli kodların yerine adapte edersiniz.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub FARKLI_KAYDET()
    Dim Dosya_Yolu, Dosya_Adı, ds
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Dosya_Adı = Sheets("PRO.HZ").Range("C7")
    Dosya_Yolu = "[URL="file://\\Erguven01\C\KREDİ"]\\Erguven01\C\KREDİ[/URL] EVRAKLARI"
    Set ds = CreateObject("Scripting.FileSystemObject")
    X = Dosya_Yolu & "\" & Dosya_Adı
    a = ds.FolderExists(X)
    If a <> True Then
    ds.CreateFolder X
    End If
 
    If Len(Dosya_Yolu) <= 3 Then Dosya_Yolu = Replace(Dosya_Yolu, "\", "")
    Sheets(Array("PRO", "Kredi Değ.", "ÖZKAYNAK", "TRM.KRD", "KEFİL")).Copy
 
    If Val(Application.Version) < 12 Then
        ActiveWorkbook.SaveAs Filename:="" & X & "\" & Dosya_Adı & " .xls"
        ActiveWorkbook.Close
    Else
        ActiveWorkbook.SaveAs Filename:="" & X & "\" & Dosya_Adı & " .xlsm"
        ActiveWorkbook.Close
    End If
 
    MsgBox Dosya_Yolu & "\" & Dosya_Adı & ".xls" & " Dosya kayıt edildi"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[djoguzz]

üstadlar teşekkürler ilgilendiğiniz için ancak aynı kodlarla nasıl oldu bilmiyorum şu an çalışıyor makro. İlk başta hata veriyordu ama şu an sıkıntı yok tıkır tıkır gidiyor. Teşekkürler herkese yinede.