Sayfayı farklı kaydetme makrosu

Emir Hüseyin Çoban · 19 Kasım 2010

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.

halit3 · 19 Kasım 2010

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.

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

http://www.excel.web.tr/f48/caly-ma-kitabyny-yedekleme-t90764/sayfa2.html

Emir Hüseyin Çoban · 19 Kasım 2010

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.

halit3 · 19 Kasım 2010

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.

Ekli dosyayı inceleyiniz.?

Emir Hüseyin Çoban · 19 Kasım 2010

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.

halit3 · 19 Kasım 2010

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.

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

Levent Menteşoğlu · 19 Kasım 2010

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

Emir Hüseyin Çoban · 19 Kasım 2010

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.

halit3 · 19 Kasım 2010

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.

İ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

OnurOnurOnur · 26 Şubat 2013

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

OnurOnurOnur · 27 Şubat 2013

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

halit3 · 27 Şubat 2013

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

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

OnurOnurOnur · 27 Şubat 2013

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

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

abdullahss · 17 Nisan 2015

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

yusuf1284 · 15 Ocak 2023

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

Hocam xlsb olarak makrolar silinmeden kaydetmek için

Kod:

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

Kullandım fakat olmadı

fikretac · 18 Nisan 2024

Halit bey 9 nolu mesajinızdaki makronun formülleri kopyalamaması için nasıl bir ekleme yapabiliriz. Tsk ederim.

Sayfayı farklı kaydetme makrosu

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

halit3

Uzman

Emir Hüseyin Çoban

Destek Ekibi

halit3

Uzman

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

halit3

Uzman

Ekli dosyalar

Levent Menteşoğlu

Administrator

Emir Hüseyin Çoban

Destek Ekibi

halit3

Uzman

OnurOnurOnur

Ekli dosyalar

OnurOnurOnur

halit3

Uzman

OnurOnurOnur

abdullahss

yusuf1284

fikretac