Farklı Kaydet Butonu Ekleme

[caneryamac]

üstadlarım var mı konu ile ilgili yardımcı olabilecek arkadaş

 

[halit3]

üstadlarım var mı konu ile ilgili yardımcı olabilecek arkadaş

sorunuzu anlayamadım ama aşağıdaki kodu bir deneyiniz.

Sub farklı_kaytet()
Dosya_Adi = Cells(9, "b").Value
If Dosya_Adi = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Uzanti = "." & fL.GetExtensionName(ThisWorkbook.FullName)
ActiveSheet.Copy
Sheets(ActiveSheet.Name).Name = "Sayfa1"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Dosya_Adi & Uzanti
ActiveWorkbook.Close False

MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

 

[caneryamac]

sorunuzu anlayamadım ama aşağıdaki kodu bir deneyiniz.

Sub farklı_kaytet()
Dosya_Adi = Cells(9, "b").Value
If Dosya_Adi = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Uzanti = "." & fL.GetExtensionName(ThisWorkbook.FullName)
ActiveSheet.Copy
Sheets(ActiveSheet.Name).Name = "Sayfa1"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Dosya_Adi & Uzanti
ActiveWorkbook.Close False

MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

Halit abi ilk verdiğim formül pdf kaydet içindi.Şimdi senin değiştirdiğini denedim ama hata aldım ekte paylaşıyorum.

 

[halit3]

Halit abi ilk verdiğim formül pdf kaydet içindi.Şimdi senin değiştirdiğini denedim ama hata aldım ekte paylaşıyorum.

ne demek istediğinizi anlıyamıyorum sorunuzu başkalarının anlıyacağı dilde sorun.

yukarıdaki mesajınızdaki kod B9 hücresindeki değere göre dosyanın hemen yanına pdf olarak kayıt yapıyordu şimdi yazdığım kod excelin sayfasını farklı kayıt yapıyor.

 

[caneryamac]

ne demek istediğinizi anlıyamıyorum sorunuzu başkalarının anlıyacağı dilde sorun.

yukarıdaki mesajınızdaki kod B9 hücresindeki değere göre dosyanın hemen yanına pdf olarak kayıt yapıyordu şimdi yazdığım kod excelin sayfasını farklı kayıt yapıyor.

Farklı kayıt yapmasını istemiştim doğru Halit Bey, yazdığınız kodu denedim ve hata aldım.Söylemek istediğimi doğru anlamışsınız.Ben anlatmaya çalışırken yetersiz olduğum için üzgünüm.Ekte dosya var belki yardımcı olur.Saygılarımla.

 

[halit3]

Farklı kayıt yapmasını istemiştim doğru Halit Bey, yazdığınız kodu denedim ve hata aldım.Söylemek istediğimi doğru anlamışsınız.Ben anlatmaya çalışırken yetersiz olduğum için üzgünüm.Ekte dosya var belki yardımcı olur.Saygılarımla.

7 nolu mesajı okudunuzmu.

 

[caneryamac]

7 nolu mesajı okudunuzmu.

Okudum Halit Bey, ben PDF olarak kaydedebiliyorum.Excelde iken makro ile yine bir Excel olarak bulunduğu klasöre kayıt yapmak istiyorum uzun bir işlem var tek tek farklı kaydet , isim gir ve makrolu alanları temizlemek zor oluyor.

 

[halit3]

kod:

Sub farklı_kaytet()
Dosya_Adi = Cells(9, "b").Value
If Dosya_Adi = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
uzanti = "." & fL.GetExtensionName(ThisWorkbook.FullName)

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

ActiveSheet.Copy
Sheets(ActiveSheet.Name).Name = "Sayfa1"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close False

MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

 

[caneryamac]

kod:

Sub farklı_kaytet()
Dosya_Adi = Cells(9, "b").Value
If Dosya_Adi = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
uzanti = "." & fL.GetExtensionName(ThisWorkbook.FullName)

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

ActiveSheet.Copy
Sheets(ActiveSheet.Name).Name = "Sayfa1"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close False

MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

Abi harikasın Allah razı olsun ikisi arasında ki farkları bulup ne değişiklik yaptığını öğreneceğim.Yolladığın kodlar çalışıyor.çok teşekkürler

 

[denese]

ekli dosyaya bir bakınız.

Halit bey emeğinize sağlık, aradığım bir çalışmaydı ve çok işime yaradı.

Saygılar