excel dosyasını iki ayrı yere kaydetme

[power]

siteden araştırdım ama istediğimi bulamadım.Flaş Bellekte tuttuğum bir excel dosyam var.üzerinde değişiklik yaptıktan sonra kaydettiğim zaman, hem var olan dosyanın kaydedilmesini, hemde konumunu daha önce belirleiğim(bilgisayarın d sürücüsü olabilir) yere kaydetmesini istiyorum.

 

[acar6783]

Hayırlı akşamlar,
Aşağıdaki kodubir butona tanımlayın istediğiniz olacaktır.

Sub kaydet()
ActiveWorkbook.Save
    ChDir "[COLOR="Red"][B]D[/B][/COLOR]:\"
    ActiveWorkbook.SaveAs Filename:="F:\Kitap1.xls", FileFormat:=xlExcel8
        
End Sub

 

[acar6783]

Bu kodları da ThisWorkbook kodbölümüne yazarsanız dosya kapanırken bu kaydetme işlemini yapar.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
kaydet
End Sub

 

[power]

Hocam anladığım kadarıyla kaydetme işlemini tanımlayacağım buton ile yapacağım.Yani excel'in kendi kaydet butonunu kullanmayacağım doğrumu?

 

[acar6783]

Farklı türlerde kullanabilirsiniz. Fakat kodların mutlakaoluşturulması gerekir.
Bir modüle kodları kopyalayın. Buradan sonra ister butona atayın isterseniz Thiswokbook kod bölümüne Kaydederken çalışması için;

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
kaydet
End Sub

 

[power]

hocam cevaplar için teşekkür ederim.yoğunluktan dolayı detaylı bakamamıştım.şimdi söylediğiniz gibi
iki koduda Thiswokbook kod bölümüne yazdım.kaydetmek istediğim zaman "rune-time error '1004' şeklinde hata mesajı alıyorum ne yapmalıuım?

 

[acar6783]

Hangi satırda sarıya boyanıyor bakabilirmisiniz?

 

[power]

ActiveWorkbook.SaveAs Filename:="F:\Kitap1.xls", FileFormat:=xlExcel8
bu satır sarıya boyanıyor.

 

[acar6783]

ActiveWorkbook.SaveAs Filename:="F:\Kitap1.xls", FileFormat:=xlExcel8
bu satır sarıya boyanıyor.

Sizde "D" Olacaktı sanırım.

 

[power]

hocam D olarakda değiştirdim sonuç aynı.

 

[acar6783]

hocam D olarakda değiştirdim sonuç aynı.

Tekrar denedim çalışıyor. Kodları tekrar kontrol edin bir yerde hatalı yazım yapmış olabilirsiniz..

Thisworkbook kodları

Private Sub Workbook_BeforeClose(Cancel As Boolean)
kaydet
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
kaydet
End Sub

İnsert - Module yaptıktan sonra da bu kodları yazacaksınız.

Sub kaydet()
ActiveWorkbook.Save
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\Kitap1.xls", FileFormat:=xlExcel8
        
End Sub

 

[power]

Hocam,
bir türlü yapamadım.İki ayrı kodu ayrı ayrı yerlere yazacağım anladığım kadarıyla.Kodları yazacağım yerleri daha ayrıntılı yazabilirmisiniz?

 

[papatya35]

geliştirici- - visual basic - insert -module yi açıp yapabilirsiniz
yalnız farklı kaydet deyip excel makro içerebilrn dosyalar şeklinde kaydedin

 

[power]

Hocam excel 2003 kullanıyorum.söyledikleriniz bu versiyonda mevcutmu? bulamadım çünkü.

 

[power]

İyi çalışmalar,
acar6783 hocamın söylediği gibi
Thisworkbook kısmına ve İnsert - Module kısmına verdiği kodları yazıyorum.F8 ile kodları çalıştırdığımda D:\ dizinine kaydediyor fakat excel dosyasını kapatıp açtığımda İnsert - Module' deki kodları göremiyorum dolayısıyla D: dizinine kayıt yapmıyor.Nerde hata yapıyorum acaba?

 

[power]

Güncel...

 

[PLİNT]

Merhaba
BuÇalışmaKitabı(thiswworkbook)
kod penceresine aşağıdaki kodları yazıp denermisiniz?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
n = Application.DefaultSaveFormat
Application.DefaultSaveFormat = ThisWorkbook.FileFormat
ThisWorkbook.SaveCopyAs "D:\" & ThisWorkbook.Name
Application.DefaultSaveFormat = n
End Sub

Yedeklenen bu dosyadada işlem yapıp kaydetme ihtimali varsa ona görede kodlara ek yapalım

 

[power]

hocam iyi geceler,
kodu denedim.istediğim gibi olmadı.Benim yapmak istediğim, üzerinde sürekli değişiklik yaptığım dosyam flaş'da.Tüm işlemlerimi burdan yapıyorum.Burda işlem yapıpda dosyayı kapatırken yada kaydet butonuna bastığım zaman aynı dosyayı d:/ dizinine kaydeydetsin istiyorum.

 

[PLİNT]

Aşağıdaki dosyayı denermisiniz?
"F" veya "D" diskinde farketmez hangisinde açıp kapatırsanız diğerine kopyalaması gerekiyor
https://www.dosyaupload.com/fmzU

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Call kayıt
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call kayıt
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call kayıt
End Sub

Sub kayıt()
Dim yol As String, n, dsk As String
Set FS = CreateObject("Scripting.FileSystemObject")
Set y = FS.GetDrive(FS.GetDriveName(ThisWorkbook.Path))
dsk = "F:"
If y = "F:" Then dsk = "D:"
n = Application.DefaultSaveFormat
Application.DefaultSaveFormat = ThisWorkbook.FileFormat
ThisWorkbook.SaveCopyAs dsk & "\" & ThisWorkbook.Name
Application.DefaultSaveFormat = n
End Sub

 

[EmrExcel16]

Sn PLİNT' in müsadesi ile alternatif olsun.
Buçalışmakitabı kod bölümüne

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim path As String
    On Error Resume Next
    path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/" 'Masaüstü ayarlanmıstır ,isteğe göre değiştiriniz.
    ThisWorkbook.SaveCopyAs path & "Kopya" & ThisWorkbook.Name
End Sub