Permission Denied Hatası

[ahmed_ummu]

Günaydın arkadaşlar.

Listbox'a koşula bağı olarak listeleme yaparken, "Permissin Denied" hatası veriyor ve kırmızı renkli olan kod satırını seçiyor. "Listbox1.Addİtem" Yardımcı olabilir misiniz.

Dim Son As Long
Set s1 = Sheets("not")
Son = s1.Cells(Rows.Count, "b").End(3).Row
For i = 1 To Son
If CDate(s1.Cells(i, "b").Value) = Format(Date, "dd.mm.yyyy") Then
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "30;70;150"
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = s1.Cells(i, "a").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = s1.Cells(i, "b").Value
ListBox1.List(ListBox1.ListCount - 1, 2) = s1.Cells(i, "c").Value
Else
End If
Next i

 

[YUSUF44]

Listbox'ın veri kaynağı olarak Rowsource seçeneği kullanılmış olabilir mi?

 

[ahmed_ummu]

Listbox'ın veri kaynağı olarak Rowsource seçeneği kullanılmış olabilir mi?

Kodları dosyamdan kopyaladım. Bu şekilde alıyor.

Yusuf bey Bu kodlar formun initialize yordamında. Form açılırken koşullu olarak listbox'a koşula uyan verileri alıyor, onda bir sorun yok. Ama başka bir kod ile tüm veriler listox'a aldırılıp, tekrar koşula uyan veriler buton yardımı ile aynı kodlarla aldırmak istediğimde oluyor bu hata.

 

[ahmed_ummu]

Bir de aşağıdaki kodlar ile başka bir sayfadan verileri kopyalayıp başka bir sayfaya aktif satıra yapıştırmak istiyorum. Silme işlemi oluyor fakat yapıştırma yapmıyor ve aşağıdaki kırmızı olan satırda hata veriyor. Kusura bakmayın fazla soru soruyorum.

cevap = MsgBox(TextBox3.Value & " adlı personeli veritabanından silmek ve arşive taşımak istiyor musunuz?", vbQuestion + vbYesNo, "Uyarı")
If cevap = vbYes Then
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Delete
Sheets("arşiv").Select
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Paste
Else
End If

 

[YUSUF44]

Örnek dosya paylaşır mısınız?

 

[ahmed_ummu]

Örnek dosya paylaşır mısınız?

Dosya ektedir, Yusuf bey.

İlk sorum userform9 da bulunan Frame23deki Commandbutton26 da "Bugünü Listele"

Diğer sorum ise userform13 üzerindeki Commandbutton1 de kodların en altındaki son 12 satır

Kusura bakmayın dosyam biraz karışık.

 

[ahmed_ummu]

Dosya ektedir.

 

[YUSUF44]

Belirttiğiniz gibi çok karışık. Yaptığınız işler açısından tüm ihtiyacınızı görüyor anladığım kadarıyla, bayağı teferruatlı hazırlanmış.

Frame23.visible diye kodunuz var ama userform açıldığında frame23 görünmüyor nedense. Bu nedenle ordaki düğmeleri inceleyemedim.

Ancak belki şöyle olabilir, sonradan ekleme işleminden önce listbox temizlenip önce initialize kodlarındaki additemler sonra da diğer additemler kullanılabilir.

 

[ahmed_ummu]

Belirttiğiniz gibi çok karışık. Yaptığınız işler açısından tüm ihtiyacınızı görüyor anladığım kadarıyla, bayağı teferruatlı hazırlanmış.

Frame23.visible diye kodunuz var ama userform açıldığında frame23 görünmüyor nedense. Bu nedenle ordaki düğmeleri inceleyemedim.

Ancak belki şöyle olabilir, sonradan ekleme işleminden önce listbox temizlenip önce initialize kodlarındaki additemler sonra da diğer additemler kullanılabilir.

İlginize çok teşekkürler Yusuf bey.

 

[ahmed_ummu]

Activecell yazıp . "Nokta" koyduğumda aşağıdaki seçenekler çıkıyor.

Activecell.Copy
Activecell.Delete
Activecell.Cut

Ama

Activecell.Paste

Çıkımyor. Aktif satıra Activecell.Entirerow.Copy ile kopyalanan satırı nasıl yapıştırabilirim arkadaşlar.

 

[Ömer]

Merhaba,

Deneyiniz.

Range("A" & ActiveCell.Row).PasteSpecial

 

[ahmed_ummu]

Merhaba,

Deneyiniz.

Range("A" & ActiveCell.Row).PasteSpecial

Merhaba Ömer bey. Range sınıfının PasteSpecial yöntemi başarısız diye hata verdi.

 

[Ömer]

Uyguladığınız kodu ve kod ile yapılmak istenini yazar mısınız.

 

[ahmed_ummu]

Uyguladığınız kodu ve kod ile yapılmak istenini yazar mısınız.

cevap = MsgBox(TextBox3.Value & " adlı personeli veritabanından silmek ve arşive taşımak istiyor musunuz?", vbQuestion + vbYesNo, "Uyarı")
If cevap = vbYes Then
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Delete
Sheets("arşiv").Select
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Range("A" & ActiveCell.Row).PasteSpecial
Else
End If

Aktif sayfanın aktif satırını kopyalayıp, arşiv sayfasında en son dolu satırın altına kopyalanan satırı yapıştıracak.

Daha önce örnek dosya göndermiştim bu konuda. Userform13 de commandbutton1 de bulunan en sondaki 12 satırlık kod bloğu.

 

[YUSUF44]

Sanıyorum kopyalama işleminden sonra satır silme yaptığınız için hata oluşuyor. Kopyaladıktan sonra önce yapıştırma sonra silme yapmak gerekir.

Yapıştırma işlemi için döngü yerine ilk boş satırı bulup doğrudan yapıştırma yapmanız iyi olur. Şöyle deneyin:

cevap = MsgBox(TextBox3.Value & " adlı personeli veritabanından silmek ve arşive taşımak istiyor musunuz?", vbQuestion + vbYesNo, "Uyarı")
If cevap = vbYes Then
    yeni = Sheets("arşiv").Cells(Rows.Count, "A").End(3).Row + 1
    ActiveCell.EntireRow.Copy Sheets("arşiv").Cells(yeni, "A")
    ActiveCell.EntireRow.Delete
End If

 

[ahmed_ummu]

Sanıyorum kopyalama işleminden sonra satır silme yaptığınız için hata oluşuyor. Kopyaladıktan sonra önce yapıştırma sonra silme yapmak gerekir.

Yapıştırma işlemi için döngü yerine ilk boş satırı bulup doğrudan yapıştırma yapmanız iyi olur. Şöyle deneyin:

cevap = MsgBox(TextBox3.Value & " adlı personeli veritabanından silmek ve arşive taşımak istiyor musunuz?", vbQuestion + vbYesNo, "Uyarı")
If cevap = vbYes Then
    yeni = Sheets("arşiv").Cells(Rows.Count, "A").End(3).Row + 1
    ActiveCell.EntireRow.Copy Sheets("arşiv").Cells(yeni, "A")
    ActiveCell.EntireRow.Delete
End If

Çok teşekkürler Yusuf bey. Hata olmadan işlemi tamamladı.