• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfayı farklı kaydetme makrosu

Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,891
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Merhaba Arkadaşlar,

Tablomun boş halinin açıp
Kod: 
Sub finans_farklı_kaydet()
ActiveWorkbook.saveas Filename:="C:\2010\" & [h10] & "\" & ActiveSheet.Range("h7") ' buradaki hicreyi değiştirerek farklılaştırabilirsin"
MsgBox "Farklı kaydet işlemi başarıyla gerçekleştirilmiştir. Çalışmanıza bu dosya üzerinden devam edin.", vbInformation, "Finansman"
End Sub

Bu kodlar ile farklı kaydediyorum ve farklı kaydettiğim dosya üzerinden çalışmaya devam ediyorum.

Şöyle bir koda ihtiyacım var, Tablo içerisindeki Giriş sayfasında "Mahsup farklı kaydet" butonunu tıkladığımda "Mahsup" sayfasını aynı dosya yoluna kaydetmeli ama dosya ismini H9 hücresinden almalı.
Mahsup sayfasını kitap olarak kaydettikten sonra, başarıyla kaydedildi diye uyarı vermeli.

Kaydetme işlemi bittikten sonra ben yine çalışmakta olduğum dosya üzerinden devam etmeliyim.

Yardım ve fikirlerinizi bekliyorum.
 

Ekli dosyalar

  • 123.rar
    123.rar
    11.8 KB · Görüntüleme: 161
huseyincoban' Alıntı:
Merhaba Arkadaşlar,

Tablomun boş halinin açıp
Kod: 
Sub finans_farklı_kaydet()
ActiveWorkbook.saveas Filename:="C:\2010\" & [h10] & "\" & ActiveSheet.Range("h7") ' buradaki hicreyi değiştirerek farklılaştırabilirsin"
MsgBox "Farklı kaydet işlemi başarıyla gerçekleştirilmiştir. Çalışmanıza bu dosya üzerinden devam edin.", vbInformation, "Finansman"
End Sub

Bu kodlar ile farklı kaydediyorum ve farklı kaydettiğim dosya üzerinden çalışmaya devam ediyorum.

Şöyle bir koda ihtiyacım var, Tablo içerisindeki Giriş sayfasında "Mahsup farklı kaydet" butonunu tıkladığımda "Mahsup" sayfasını aynı dosya yoluna kaydetmeli ama dosya ismini H9 hücresinden almalı.
Mahsup sayfasını kitap olarak kaydettikten sonra, başarıyla kaydedildi diye uyarı vermeli.

Kaydetme işlemi bittikten sonra ben yine çalışmakta olduğum dosya üzerinden devam etmeliyim.

Yardım ve fikirlerinizi bekliyorum.
Genişletmek için tıkla ...

Aşağıdaki linkdeki 13 nolu mesajdaki kodu inceleyiniz.

http://www.excel.web.tr/f48/caly-ma-kitabyny-yedekleme-t90764/sayfa2.html
 
Sy Halit3 Hocam, bu link altında tüm çalışma kitabını farklı kaydetme konusunda çok fazla örnek paylaşmıştınız teşekkürler.

Linki tekrar inceledim, ancak bu işlemi zaten yukarda verdiğim kodlarla yaptım. Bu sefer Giriş sayfasındayken, sadece Mahsup sayfasını yedeklemek istiyorum.
Böyle bir işlem istememin sebebi, bazı birimler tablodaki tüm sayfaları görmemeli. Bu yüzden içerisindeki Mahsup sayfasını ayrı bir kitap olarak çıkarmalıyım.

Konuyu açmadan öncede "Dosya işlemleri" paylaşımınızı inceledim. Ancak mahsup sayfasındaki işlemleri bitirdikten sonra pratik bir şekilde yedekleyip, çalışmakta olduğum tabloda devam edebilmeliyim.
 
huseyincoban' Alıntı:
Sy Halit3 Hocam, bu link altında tüm çalışma kitabını farklı kaydetme konusunda çok fazla örnek paylaşmıştınız teşekkürler.

Linki tekrar inceledim, ancak bu işlemi zaten yukarda verdiğim kodlarla yaptım. Bu sefer Giriş sayfasındayken, sadece Mahsup sayfasını yedeklemek istiyorum.
Böyle bir işlem istememin sebebi, bazı birimler tablodaki tüm sayfaları görmemeli. Bu yüzden içerisindeki Mahsup sayfasını ayrı bir kitap olarak çıkarmalıyım.

Konuyu açmadan öncede "Dosya işlemleri" paylaşımınızı inceledim. Ancak mahsup sayfasındaki işlemleri bitirdikten sonra pratik bir şekilde yedekleyip, çalışmakta olduğum tabloda devam edebilmeliyim.
Genişletmek için tıkla ...


Ekli dosyayı inceleyiniz.?
 

Ekli dosyalar

  • 123.rar
    123.rar
    15.1 KB · Görüntüleme: 269
Sy Halit3 Hocam, ilginiz için teşekkürler. Zahmetler veriyorum.

İlk mesajımda belirttiğim kodlar ile çalışma kitabını farklı kaydede biliyorum.
Kodlar içerisinde belirttiğim dosya yoluna kaydediyor.

Çalışma sayfasını böyle farklı kaydede bilirmiyiz. Butonu tıkladığımda belirttiğim dosya yoluna Mahsup sayfasını yedeklemeli. Bana sadece uyarı mesajı vermeli.
 
huseyincoban' Alıntı:
Sy Halit3 Hocam, ilginiz için teşekkürler. Zahmetler veriyorum.

İlk mesajımda belirttiğim kodlar ile çalışma kitabını farklı kaydede biliyorum.
Kodlar içerisinde belirttiğim dosya yoluna kaydediyor.

Çalışma sayfasını böyle farklı kaydede bilirmiyiz. Butonu tıkladığımda belirttiğim dosya yoluna Mahsup sayfasını yedeklemeli. Bana sadece uyarı mesajı vermeli.
Genişletmek için tıkla ...

ekli dosyadaki kodlara kayıt ederken dosya varnı yokmu sorgusu ekledim.
 

Ekli dosyalar

  • 123.rar
    123.rar
    15 KB · Görüntüleme: 157
Kısaca aşağıdaki gibide kaydedebilirsiniz.

Kod: 
Sub mahsupkaydet()
yol = ThisWorkbook.Path
ad = [giriş!h10]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("MAHSUP").Copy
If Val(Application.Version) > 11 Then
ActiveWorkbook.SaveAs Filename:=yol & "\" & ad & ".xls", FileFormat:=xlExcel8
Else
ActiveWorkbook.SaveAs Filename:=yol & "\" & ad & ".xls"
End If
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub
 
Sy Halit3 Hocam, tekrardan teşekkür ederim. Paylaştığınız bütün kodlar çalışıyor ancak istediğim şekle uyarlayıncaya kadar zahmetler verdim size. Son paylaştığınız kodlar ile istediğim kaydetme işlemini sorunsuz yapıyor şuan.

Sy Levent Menteşoğlu, ilginiz ve paylaşımınız için teşekkürler. Paylaştığınız kodlarıda denedim.
Sorunsuz çalışıyor.

İyi akşamlar dilerim.
 
huseyincoban' Alıntı:
Sy Halit3 Hocam, tekrardan teşekkür ederim. Paylaştığınız bütün kodlar çalışıyor ancak istediğim şekle uyarlayıncaya kadar zahmetler verdim size. Son paylaştığınız kodlar ile istediğim kaydetme işlemini sorunsuz yapıyor şuan.

Sy Levent Menteşoğlu, ilginiz ve paylaşımınız için teşekkürler. Paylaştığınız kodlarıda denedim.
Sorunsuz çalışıyor.

İyi akşamlar dilerim.
Genişletmek için tıkla ...

İyi çalışmalar.

6 nolu mesaja dosyanı ekledim kayıt ederken dosya varmı yokmu sorguluyor.

Kod: 
Sub Mahsup_Farklı_Kaydet()
Klasor = "C:\"
Dosya_Adi = Worksheets("GİRİŞ").Range("H9").Value
Sayfa_Adı = "MAHSUP"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets(Sayfa_Adı).Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
 
Ekteki görüntüdeki gibi, TEXTBOX'a yazılan şifre doğruysa "yönetici girişi"ne basıldığında "rapor" sheet'ini farklı kaydetmesini istiyorum. Nasıl yapabilirim bunu?

mesela "rapor" sheet'ini silmek için böyle denedim oldu.

:)

Kod: 
Private Sub CommandButton4_Click()

If Val(TextBox8) = "12345" Then
Sheets("rapor").Range("A2:Z1000") = ""
Else
MsgBox "Hatalı Şifre"
End If
End Sub
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    22 KB · Görüntüleme: 10
Son düzenleme:
bunu da çözdüm :)

Kod: 
Private Sub CommandButton5_Click()

If Val(TextBox8) = "12345" Then
    Sheets("rapor").Visible = True
    Sheets("rapor").Select
    Range("A1:Z1000").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Windows("mevcut_dosya_adi").Activate
    Sheets("rapor").Select
    Sheets("rapor").Visible = False
    
Else
MsgBox "Hatalı Şifre"
End If
End Sub
 
OnurOnurOnur' Alıntı:
Ekteki görüntüdeki gibi, TEXTBOX'a yazılan şifre doğruysa "yönetici girişi"ne basıldığında "rapor" sheet'ini farklı kaydetmesini istiyorum. Nasıl yapabilirim bunu?

mesela "rapor" sheet'ini silmek için böyle denedim oldu.

:)

Kod: 
Private Sub CommandButton4_Click()
 
If Val(TextBox8) = "12345" Then
Sheets("rapor").Range("A2:Z1000") = ""
Else
MsgBox "Hatalı Şifre"
End If
End Sub
Genişletmek için tıkla ...

kod:

Kod: 
Private Sub CommandButton4_Click()
If Val(TextBox8) = "12345" Then
Klasor = "C:\"
Dosya_Adi = "box1"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets("rapor").Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Else
MsgBox "Hatalı Şifre"
End If
End Sub
 
halit3' Alıntı:
kod:

Kod: 
Private Sub CommandButton4_Click()
If Val(TextBox8) = "12345" Then
Klasor = "C:\"
Dosya_Adi = "box1"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets("rapor").Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Else
MsgBox "Hatalı Şifre"
End If
End Sub
Genişletmek için tıkla ...

abi benim kod ile farkı ne olmuş oldu? ben kaydettirmedim o kısmı biliyorum, çünkü herkes istediği yere kaydetsin dedim. ancak senin koddaki bazı alanlar kafamı karıştırdı;

örn:

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
 
sayfayı farklı kaydetmede resim sorunu

bu kodlara göre sayfanın yedeği alınıyor sayfa üstünde resim varsa bunları almıyor,resimleride almak için nasıl bir kod eklemek gerekli?

halit3' Alıntı:
İyi çalışmalar.

6 nolu mesaja dosyanı ekledim kayıt ederken dosya varmı yokmu sorguluyor.

Kod: 
Sub Mahsup_Farklı_Kaydet()
Klasor = "C:\"
Dosya_Adi = Worksheets("GİRİŞ").Range("H9").Value
Sayfa_Adı = "MAHSUP"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets(Sayfa_Adı).Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Genişletmek için tıkla ...
 
halit3' Alıntı:
kod:
Kod: 
Private Sub CommandButton4_Click()
If Val(TextBox8) = "12345" Then
Klasor = "C:\"
Dosya_Adi = "box1"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets("rapor").Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Else
MsgBox "Hatalı Şifre"
End If
End Sub
Genişletmek için tıkla ...

Hocam xlsb olarak makrolar silinmeden kaydetmek için

Kod: 
ActiveWorkbook.SaveAs Klasor & dosya_adi & uzanti, FileFormat:=50

Kullandım fakat olmadı
 
Halit bey 9 nolu mesajinızdaki makronun formülleri kopyalamaması için nasıl bir ekleme yapabiliriz. Tsk ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst