Klasör içine worbook kopyalama ve Cancel kodu

[hassan26]

Selam Arkadaşlar
Private Sub CommandButton1_Click()
On Error Resume Next
ad = InputBox("Klasör ismi girin")
MkDir "c:\" & [ad]
kayıt = InputBox("ismi girin")
ThisWorkbook.SaveAs "c:\" & [ad] & ".xls"
End Sub
Yapmaya çalıştığım uydurma olan (ayrı çalışmalardan birleştirdim) bu kodla c: directory içinde bir klasör oluşturup aktif olan workbook'u istediğim isimde bu klasörün içine kopyalamak. Olmasına oluyorda klasör ayrı, sayfa ayrı oluşuyor nasıl uyarlamalıyımki çalışma kitabını oluşan klasörün içine kaydetsin.

İkinci sorumda
Private Sub CommandButton2_Click()
Dim cevap
cevap = MsgBox("Çıkmadan Önce Kaydetmek istermisiniz ?", vbYesNoCancel, " DİKKAT")
If cevap = 7 Then
Application.Quit
Application.DisplayAlerts = False
Else
ActiveWorkbook.Save
Application.Quit
End If
End Sub
Kodunda Msgbox da oluşan yes no butonlarının ne yapması gerektiğinin cevapları varda Cancel modunu nasıl çalıştırabilirim yani Cancel'e tıklanınca hiç bir işlem yapmadan Msgbox kapanacak
Saygılar

 

[Ferhat Pazarçevirdi]

1. Sorunuzun cevabı için aşağıdaki kodu kullanın

Dim yol As String
Sub KlasorVeDosyaYarat()
YeniKlasorIsmi = InputBox("Oluşturulacak Klasorün Adını giriniz")
If YeniKlasorIsmi = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
   On Error Resume Next
   yol = "C:\" & YeniKlasorIsmi
   sonuc = FSO.CreateFolder(yol)
   If Err = 0 Then
        MsgBox sonuc & vbCrLf & " yoluyla bir klasor yaratıldı", vbInformation
   Else
        MsgBox sonuc & vbCrLf & Err.Description, vbExclamation
   End If
Set FSO = Nothing
   YeniDosyaIsmi = InputBox("Dosya Adını giriniz")
   ThisWorkbook.SaveAs yol & "\" & YeniDosyaIsmi & ".xls"
End Sub

2.Sorunuzun cevabı için; Select Case 'i kullanabilirsiniz. Şöyle ki;

Private Sub CommandButton2_Click()
Dim cevap
cevap = MsgBox("Çıkmadan Önce Kaydetmek istermisiniz ?", vbYesNoCancel, " DİKKAT")
Select Case cevap
  Case vbYes: ActiveWorkbook.Save: Application.Quit
  Case vbNo: Application.Quit: Application.DisplayAlerts = False
  Case Else
End Select
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub CommandButton1_Click()
On Error Resume Next
ad = InputBox("Klasör ismi girin")
MkDir "c:\" & ad
kayıt = InputBox("ismi girin")
ThisWorkbook.SaveCopyAs "c:\" & ad & "\" & kayıt & ".xls"
End Sub
 
Private Sub CommandButton2_Click()
Dim cevap
cevap = MsgBox("Çıkmadan Önce Kaydetmek istermisiniz ?", vbYesNoCancel, " DİKKAT")
If cevap = vbCancel Then Exit Sub
If cevap = 7 Then
Application.Quit
Application.DisplayAlerts = False
Else
MsgBox "yes"
ActiveWorkbook.Save
Application.Quit
End If
End Sub

 

[hassan26]

Sayın fpc üstad ilgine teşekkür ederim kodlar mükemmel oldu
Merak ettim Workbook değilde bu workbook içinde 30 worksheet var seçime bağlı olarak sadece worksheetleri kopyalattırabilirmiyiz yani Save as yaparken atıyorum 10 tanesi hariç diğer 20 worksheet'i ayrıca hücrelerdeki bağlantıları kesip sadece değer halinde workbook olarak kopyalama yaparmı Kısaca Klasör oluşturup bizim Workbook'u oraya kopyalarken içinden isteğe bağlı 5-10 worksheet hariç tutabilirmi.

 

[hassan26]

Sayın leventm sizede teşekkür ederim her ikinizinde verdiği kodlar güzel çalışıyor. Oh ne ala bir soru sor bir sürü net cevap al ALLAH (c.c.) razı olsun hepinizden.

 

[Ferhat Pazarçevirdi]

Tabiki olur. Ancak verimli olması açısından bir Userform ile çalışmakta fayda var. Userform üzerinde bir Listbox ilavesi ile çoklu sayfa seçimi yaptırılıp, "tamam" diye bir buton koyulduğunda; ilgili klasörün içine seçilmiş sheetlerden oluşmuş bir workbook kaydedilebilir.

Orjinal şablon dosyanızı eklerseniz üzerinde çalışabiliriz.

Allah sizden de razı olsun.

NOT : Levent hocamızın soruyu cevapladığını farketmemişim. Arya girdiğim için kusura bakmayın hocam.

 

[Levent Menteşoğlu]

.........NOT : Levent hocamızın soruyu cevapladığını farketmemişim. Arya girdiğim için kusura bakmayın hocam.

Rica ederim Sn fpc, önce cevap veren sizsiniz, dolayısıyla araya giren ben olmuş oldum. Ayrıca bu tip mesajlar yazmanıza hiç gerek yok, Sizden ricam cevabınızı göndermekte asla tereddüt etmemenizdir.

 

[hassan26]

sayın fpc örnek bir dosya ekliyorum aslını buraya upload etmedim çünkü bir sürü yerde tc kimlik no ve tel noları mevcut hepsini temizlemem uzun süreceği için bu şekilde ekliyorum umarım anlayışla karşılarsınız.

 

[Ferhat Pazarçevirdi]

Ekteki örneği inceleyiniz.

 

[hassan26]

Sayın fpc
eklediğiniz dosyadaki kodu kendi sayfalarıma uyarladım çalışıyor ancak 32 sayfanın kopyasını yapıyor fazla seçim yapılınca dosya ve klasör oluşturmuyor VBA
ThisWorkbook.Sheets(ListBox1.List(i, 0)).Copy After:=Workbooks(YeniKitap.Name).Sheets(Sheets.Count) bu satırı işaretleyip hata veriyor
Birde hücrelerdeki bağlantıları kesip sadece değer halinde kopyalama yaparmı oluşan dosya güncelleme istiyorda çünkü ben kopyalama işleminden sonra verileri silip yeni ay bilgileri girip bir başka adla yedekliyeceğim otomatik güncelleme iptal edilebilirmi.
saygılarımla

 

[Ferhat Pazarçevirdi]

Söylediklerinizden sonra; bu dosyaya 70 adet daha sheet ilave ettim.

Kodlar; 70 adet sheet'in tamamını seçip, yeni bir kitap oluşturuyor. Yani 32.sheet'te hata vermesi bu yapı ile pek mümkün değil.

Orjinal dosyaya uyarlarken, kodlarda düzenleme (ekleme, silme, düzelme vb) yaptınız mı hiç?

 

[hassan26]

Hayır hiç bir şey yazmadım silmedim
Worksheet sınıfının copy yöntemi başarısız uyarısı ve ardından VBA
ThisWorkbook.Sheets(ListBox1.List(i, 0)).Copy After:=Workbooks(YeniKitap.Name).Sheets(Sheets.Count) satırını işaretleyip hata veriyor ancak ben klasör ve dosya ismi yazdığım halde hazırda kitap1 diye bir dosya açılıyor içine bakıyorum kopyalama işlemi oluşmuş ama c:\ içinde böyle bir dosya yok kapatırken kaydediyimmi sorusunu evet deyince kitap1 adında ve ana dosyamın yanına kayıt oluşturuyor kaydet seçeneğini seçmezsem kayıt yapmıyor hepsini kapatıp c:\ bakıyorum dosya falan yok
32 dosya seçip denedim oldu yine 32 den fazla kayıt yapmıyor.

 

[Ferhat Pazarçevirdi]

Ekteki dosyada; toplam 107 adet sheet var. Bahsettiğiniz gibi 32'den de fazla seçim yaparak sonucu bana tekrar bildiriniz.

Ayrıca;

(1) Orjinal dosyanızda, gizlenmiş (Hidden veya VeryHidden) sayfalar var mı?
(2) Kopyalanan sheetlerin VBA kod sayfalarında, kodlar var mı?
(3) Kitabınızda veya sheetlerinizde koruma var mı?

Ek olarak; VBE'de iken; Ctrl+G tuşlarına basın. Immediate Window penceresi açılacak.

Hata veren dosyanızdaki kodları yine çalıştırın. Hata mesajı verdiği zaman; "Debug" tuşuna basın.

Aşağıdakileri “Immediate Penceresine” tek tek yazın ve her yazdığınızda enter’e basın. Alt satırda sonuçlar görünecektir veya hata verecektir. Bunları bana bildiriniz. (Başlarındaki “?” işaretini de mutlaka yazınız)

? ListBox1.List(i, 0)
? YeniKitap.Name
? Sheets.Count