Makro İle Silerken Veri Varsa uyarı Versin

[CRAYZLOVEIS]

Arkadaşlar aşağıdaki makro sadece belirlenen hücrelerde içeri temizliyor. Acaba buna bir uyarı eklemek mümkün mü. yani hücrelerde veri varsa "Silmek istediğinize emin misiniz" diye uyarı versin. Şimdiden Tşk..

Sub DIGER()
Range("J32:AC41,AE32:AX41,AZ32:BS41").Select
Selection.ClearContents
ExecuteExcel4Macro ("SOUND.PLAY(, ""C:\Windows\Media\recycle.wav"")")
Range("J16:K16").Select
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub SİL()
    SAY = WorksheetFunction.CountA(Range("J32:AC41,AE32:AX41,AZ32:BS41"))
    If SAY > 0 Then
    ONAY = MsgBox("Silmek istediğinize emin misiniz?", vbCritical + vbYesNo, "Dikkat !")
    If ONAY = vbYes Then
    Range("J32:AC41,AE32:AX41,AZ32:BS41").ClearContents
    ExecuteExcel4Macro ("SOUND.PLAY(, ""C:\Windows\Media\recycle.wav"")")
    End If
    End If
End Sub

 

[CRAYZLOVEIS]

Üstad eline sağlık yüksek müsaadelerinizle bir soru daha sormak istiyorum. Aslında basit bir soru ama kullanmak istediğim özelliği auto open prosedürüyle kapattığım için ben yapamadım. Basitçe anlatayım. J9 hücresineki adres bilgisini "J21" hücresine koplaya ve özel yapıştır yöntemi ile yazdırmak istiyorum. Fakat dediğim gibi kopya yapıştır vs.. özellikleri kapattığım için yapamadım

NOT:J9 Hücresi Kilitli Bir Hücre
NOT:J21 Hücresi Kilitli Değil

Açılıştaki Kodlar

'Sub auto_open()
' Range("J16").Select
'kopyala kes yapıştırı açılışta pasif yapar
' EnableControl 21, False 'Kes
' EnableControl 19, False ' Kopyala
' EnableControl 22, False ' Yapıştır
' EnableControl 755, False ' özelyapıştır
' Application.OnKey "^c", "yasakla"
' Application.OnKey "^v", "yasakla"
' Application.CellDragAndDrop = False 'hücreyi çoğaltma ve taşıma
' CommandBars("ToolBar List").Enabled = False 'düzen menüsündeki ilgili menüleri gizle
'End Sub

 

[Korhan Ayhan]

Selamlar,

J9 hücresiniz kilitli ise sanırım sayfanızda koruma yapıyorsunuz. Aşağıdaki kodu denermisiniz.

Sub KOPYALA()
    ActiveSheet.Unprotect ' "[COLOR=red]Şifreniz[/COLOR]"
    EnableControl 19, True
    [J9].Copy
    Range("J21").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    EnableControl 19, False
    ActiveSheet.Protect ' "[COLOR=red]Şifreniz[/COLOR]"
End Sub

 

[CRAYZLOVEIS]

Üstad maalesef hata verdi. Örnek bir dosya ekliyorum. İlgin için teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu eksik uygulamışsınız. Modül3 bölümüne aşağıdaki kodu ekleyip tekrar deneyiniz.

Sub EnableControl(Id As Integer, Enabled As Boolean)
  Dim CB As CommandBar
  Dim C As CommandBarControl
  For Each CB In Application.CommandBars
    Set C = CB.FindControl(Id:=Id, recursive:=True)
    If Not C Is Nothing Then C.Enabled = Enabled
  Next
End Sub

 

[CRAYZLOVEIS]

Üstad maalesef yapamadım... Örnek Dosyada sizin dediğiniz şekilde değiştirdim fakat olmadı. Dosya üzerinde gösterirseniz memnun olurum. Birde işlemi yapması için butona bastığım zaman sayfa koruma parolasını girmemi istiyor. Bunu girmeden yapamazmıyım. Tşk.

NOT: ÖRNEK DOSYAYI değiştirdim.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

 

[CRAYZLOVEIS]

Üstad eline sağlık tşk.