• DİKKAT

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

makroya msgbox ekleme hk.

E

EGULERYUZ

Katılım
21 Şubat 2017
Mesajlar
64
Excel Vers. ve Dili
2022 365 TÜRKÇE
aşagıdaki formüle" silmeyi onaylıyormusun"msgbox eklemek istiyorum bir türlü halledemedim çok örnekle ugrstım fakat formüün neresine eklenecek bulamadım yardım ederseniz sevinirim...



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B10000")) Is Nothing Then
On Error Resume Next
If Target = "" Then Cells(Target.Row, Target.Column + 1).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 2).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 3).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 4).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 5).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 8).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 9).Value = ""
If Target = "" Then Cells(Target.Row, Target.Column + 10).Value = ""
End If
End Sub
 
Son düzenleme:
bu şekilde deneyiniz.
Kod: 
If Not Intersect(Target, Range("B4:B10000")) Is Nothing Then
[B]cevap = MsgBox("Silmeyi onayla!", vbYesNo, "Sil")
  If cevap = 6 Then[/B]
    On Error Resume Next
    If Target = "" Then Cells(Target.Row, Target.Column + 1).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 2).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 3).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 4).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 5).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 8).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 9).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 10).Value = ""
 [B] End If[/B]
End If
 
systran' Alıntı:
bu şekilde deneyiniz.
Kod: 
If Not Intersect(Target, Range("B4:B10000")) Is Nothing Then
[B]cevap = MsgBox("Silmeyi onayla!", vbYesNo, "Sil")
  If cevap = 6 Then[/B]
    On Error Resume Next
    If Target = "" Then Cells(Target.Row, Target.Column + 1).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 2).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 3).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 4).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 5).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 8).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 9).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 10).Value = ""
 [B] End If[/B]
End If
Genişletmek için tıkla ...

malesef çalışmadı sayın systran
 
Başında bu komut olmalı,Aşağıdaki olay altına kodları kopyalayınız.
Private Sub Worksheet_Change(ByVal Target As Range)
veya seçim yapılacaksa
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
olabilir.
 
teşekkür ederim yardımlarınız için.....Hakkınızı helal ediniz..

Fakat hayır dediğimizdede silme gerçekleşiyor..
bu konuyu nasıl hallederim...
 
Son düzenleme:
Sayın EGULERYUZ aşağıdaki kodunuz, B4:B1000 hücresinde seçtiğiniz hücre boş ise ve evet seçerseniz siliyor.Hayır seçerseniz silme işlemi yapmıyor.
Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B10000")) Is Nothing Then
cevap = MsgBox("Silmeyi onayla!", vbYesNo, "Sil")
  If cevap = 6 Then
    On Error Resume Next
    If Target = "" Then Cells(Target.Row, Target.Column + 1).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 2).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 3).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 4).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 5).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 8).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 9).Value = ""
    If Target = "" Then Cells(Target.Row, Target.Column + 10).Value = ""
  End If
End If
End Sub
 
sayın çıtır,aynı sayfada başka kodlarda olduğundan çalıştıramadım,

Dosyamı ekte sunuyorum "gerçek" sayfasında F5: ile AJ:24 aralığındaki hücreler seçilip sil komutu verildiğinde msgbox çalışmasını ve onaya bağlı işlem gerçekleştirmesini sağlamak istiyorum ,
yardımlarınız için şimdiden teşekkürler...
 

Ekli dosyalar

Aşağıdaki kodu deneyiniz.

Kod: 
Sub TABLOYU_TEMİZLE()
    Onay = MsgBox("Tablo içeriğini temizlemek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2)
    If Onay = vbNo Then Exit Sub
    Range("F5:AJ24").ClearContents
    MsgBox "Tablodaki eski bilgiler temizlenmiştir.", vbInformation
End Sub
 
Korhan bey ,
zaman ayırdığınız için teşekkür ederim,fakat bu kod işimi çöznedi,benim yapmak istediğim f:5 ile aj:24 arasındaki hücreleri silmek istediğimizde(sağ tuş ile veya delete tuşu)uyarı mesajı vermesi.birde aynı sayfada çalışan kod ile beraber nasıl çalıştırırım ?dosya 7 mesajda dır....
 
Kitabınızın "BuÇlaışmaKitabı" bölümüne aşağıdaki kodu uygulayınız.

Kod: 
Private Sub Workbook_Activate()
    Application.OnKey "{DELETE}", "TABLOYU_TEMİZLE"
    Application.CommandBars.FindControl(ID:=292).Enabled = False
    Application.CommandBars.FindControl(ID:=3125).Enabled = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{DELETE}"
    Application.CommandBars.FindControl(ID:=292).Enabled = True
    Application.CommandBars.FindControl(ID:=3125).Enabled = True
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "{DELETE}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "{DELETE}", "TABLOYU_TEMİZLE"
    Application.CommandBars.FindControl(ID:=292).Enabled = False
    Application.CommandBars.FindControl(ID:=3125).Enabled = False
End Sub

Boş bir modüle aşağıdaki kodu uygulayın.

Kod: 
Sub TABLOYU_TEMİZLE()
    Onay = MsgBox("Tablo içeriğini temizlemek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2)
    If Onay = vbNo Then Exit Sub
    Range("F5:AJ24").ClearContents
    MsgBox "Tablodaki eski bilgiler temizlenmiştir.", vbInformation
End Sub

Dosyanızı kayıt edip kapatın ve açın.

Sonra alan üzerinde DELETE tuşuna basın ve sonucu gözlemleyin.
 
Sayın Korhan hocam modül çalıştı fakat delete tuşu işlevi devam ediyor...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst