AccessTr.neT

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

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.

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

Sayın @alicimri @feraz Zafer Hocam elinize emeğinize sağlık. Dosyayı inceleyip bilgi vereyim

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.

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