Skip to main content

AccessTr.neT


Comment Açıklama Bilgisi Kodunu Revize Etmek

Comment Açıklama Bilgisi Kodunu Revize Etmek

#25
Sayın @hayalibey
Aşağıdaki kod ile Ayrık da olsa çoklu seçim yapabilirsiniz.
1- Çıkan imputbox'a x yazıp, OK düğmesine tıklarsanız. seçimdeki Açıklamaları siler.
2- Boş bırakıp OK veya boş bırakmasanız bile Cancel düğmesine basarsanız işlem yapmadan çıkar
3- 'x' değerinin dışındaki değer yazaranız Açıklama ekler
4- Ayrık olarak seçim yapacaksanız her seçimde imputbox'ı Cancel ile çıkı, Ctrl tuşuna basarak devam edin seçim işlemi bitince açıklamayı yazıp OK tıklayın
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  myvalue = InputBox("'x' değer açıklamaları siler", "AÇIKLAMA")
If myvalue = "" Then
Exit Sub
ElseIf myvalue = "x" Then
Selection.ClearComments
Else
Selection.ClearComments
  ActiveCell.AddComment
ActiveCell.Comment.Text Text:=myvalue
ActiveCell.Copy
   Selection.PasteSpecial Paste:=xlPasteComments
End If
End Sub

Cevapla
#26
Sayın @feraz Evet VERİ sayfasında 11. kayıttan sonraki) fazla olan karakterin farkındayım (160 kodlu) konu ve/veya konularla  yaptığım örneklerde bu durumu düzeltmiştim, ama uyarmayı unutmuştum.
Son Düzenleme: 21/11/2020, 14:32, Düzenleyen: alicimri.
Cevapla
#27
Oldumu bilmiyorum yinede bir deneyiniz.

Yaptıkları şunlar;
Ocak ayı için kodu ekledim.
F7:FAJ son satır aralığında tıklayınca kod çalışır.

Eğer tek hücre seçilirse ve çoklu hücre seçilirse ılarak ayarladım.
Tek hücre seçilirse Açıklama varsa o açıklama inputboxa gelir çok seçimde yapmadım mantıkende olmaz bence.
Eğer inputbox boşsa ve çıkan mesaj evet seçilirse seçilen hücrelerdeki açıklamalar silinir.
Boş değilse seçilenlerin hepsine inputboxttaki ne ise o yazdırılır açıklama olarak.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açıklama_Ekleme As Comment, aa As String
Dim strText, hucre As Range, hucre2 As Range, son As Long

son = ActiveSheet.Range("Aj" & Rows.Count).End(3).Row

If Target.Row < 7 Then Exit Sub
If Target.Row > son Then Exit Sub
If Target.Column < 7 Then Exit Sub
If Target.Column > 36 Then Exit Sub
If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

Set Açıklama_Ekleme = Target.Comment
If Not Açıklama_Ekleme Is Nothing Then
    strText = Application.InputBox("Eklenecek olan mesajı aşağıya yazınız.", "Açıklama_Ekleme", Target.Comment.text, , , , 2)
Else
    strText = Application.InputBox("Eklenecek olan mesajı aşağıya yazınız.", "Açıklama_Ekleme", "Açıklama Ekler", , , , 2)
End If

If strText = False Then Exit Sub
'Eger inputbox bossa
If strText = "" Then
    'eger inputbox bossa ve msaj kuutundan evet secilirse
    If MsgBox("Secilen aciklamalar silinsin mi?", vbQuestion + vbYesNo) = vbYes Then
        'eger tek hücre secilmisse
        If Target.Cells.Count = 1 Then
            sil Target
        'eger birden fazla hücre secilmisse
        Else
            For Each hucre2 In Selection
                sil hucre2
            Next
        End If
    End If
'eger inputbox bos degilse
Else
    'eger tek hücre secilmisse
    If Target.Cells.Count = 1 Then
        ekle Target, strText
    'eger birden fazla hücre secilmisse
    Else
        For Each hucre2 In Selection
            ekle hucre2, strText
        Next
    End If
End If

End Sub

Sub ekle(hucre As Range, metin)
    hucre.AddComment
    Set Açıklama_Ekleme = hucre.Comment
    With Açıklama_Ekleme
        .text text:=metin
        With .Shape.TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 8
            .Bold = False
        End With
    End With
End Sub
[vb]
Sub sil(hucre As Range)
    On Error Resume Next
    hucre.Comment.Delete
    On Error GoTo 0
End Sub

[Resim: do.php?img=10602]
.rar Puantaj YILDIZ1 comment son.rar (Dosya Boyutu: 461,63 KB | İndirme Sayısı: 2)
Cevapla
#28
Sayın @alicimri @feraz Zafer Hocam elinize emeğinize sağlık. Dosyayı inceleyip bilgi vereyim
Cevapla
#29
Zafer Hocam alicimri hocam elinize emeğinize sağlık açıklama olmuş test diyorum ve şu an için hata çıkmadı biraz daha deneyeceğim.
Cevapla
#30
toplu seçimde açıklama girilen hücreler yeniden seçildiğinde Açıklama Ekler yazısı okey şeklinde tıklanırsa hata veriyor Vba açılıyor

Bu şekilde toplu seçimde inputbox boş gelse yada hata vermese
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task