Farklı Kaydet Makrosu

[mkokluce]

Merhabalar,
vba konusunda çok acemiyim.Okulda kullandığım "Kbs ekders puantaj xls. uzantılı " excel sayfasındaki aşağıdaki makroyu çalıştırdığımda "object doesn't support this action"hatası veriyor.Bu sorunu aşmamda yardımcı olursanız sevinirim.

Ofis 2010 32 bit kullanıyorum.





Sub KBS_4YuvarlatılmışÇaprazKöşeliDikdörtgen_Tıklat()

Sayfa_Adı = ActiveSheet.Name
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)

If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"


On Error Resume Next

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
dosya_adi = fL.GetBaseName(Dosya)
Uzanti = fL.GetExtensionName(Dosya)


yer = Kaynak & Format(Now, "mmmm") & " " & Format(Now, "yyyy")

Sheets("KBS").Select
Sheets("KBS").Copy



Application.DisplayAlerts = False

If Uzanti = "xls" Then
FileFormatNum = -4143
ElseIf Uzanti = "xlsm" Then
FileFormatNum = 52
ElseIf Uzanti = "xlsx" Then
FileFormatNum = 51
ElseIf Uzanti = "xlsb" Then
FileFormatNum = 50
Else
FileFormatNum = 56
End If

ActiveWorkbook.SaveAs yer & "." & Uzanti, FileFormat:=FileFormatNum 'Uzanti

For i = ActiveWorkbook.Sheets.Count To 1 Step -1
Sheets(i).Select
ActiveSheet.DrawingObjects.Delete
Next i

For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
Next

ActiveWorkbook.Save
ActiveWindow.Close
Sheets(Sayfa_Adı).Select
MsgBox "KBS Dosyanız Hazırlandı !", vbInformation, "DİKKAT"

Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[mkokluce]

Yanlış bölüme mi konu açtım acaba.Lütfen uyarın.