Evidenziare Cella che contiene Commento

Question

Buona sera a tutti,

ho una piccola richiesta.

In un foglio di Excel ho delle celle dedicate a  contenere solo commenti.

Desidererei che quando una di queste celle contiene un commento nelle cella stessa apparisse la scritta "Commento".

Sarebbe un'evidenza in più che si aggiunge al triangolino rosso che appare in automatico nella cella in alto destra.

Si può creare qualche riga di codice in VBA che rilevi l'immissione del commento ?

Ringrazio in anticipo chi potrà darmi qualche suggerimento.

un saluto

Answer 1

Ciao Robi,

Più resistente sarebbe la seguente versione:

'=======>>

Option Explicit

'------------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim rCell As Range

    Dim sStr As String, aStr As String

    Const myStr As String = "Commento"

    Set WB = Workbooks("Pippo.xlsm")                                     '<<===== Modifica

    Set SH = WB.Sheets("Foglio1")                                              '<<===== Modifica

    sStr = Application.UserName & ":"

    Set Rng = SH.UsedRange.SpecialCells(xlCellTypeComments)

    If Not Rng Is Nothing Then

        For Each rCell In Rng.Cells

            With rCell

                aStr = Replace(.Comment.Text, Chr(10), vbNullString)

                If Not aStr = sStr And CBool(Len(aStr)) Then

                    If IsEmpty(.Value) Then

                        .Value = myStr

                    End If

                ElseIf .Value = myStr Then

                    .ClearContents

                End If

            End With

        Next rCell

    End If

End Sub

'<<=======

Tuttavia, visto il mio commento:

io non sono convinto dell'utilità del codice richiesto

credo che mi convenga a suggerire una più valida alternativa per evidenziare i commenti non vuoti. Quindi, prova a sostituire il codice precedente con la seguente versione:

'==========>>

Option Explicit

'---------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim rCell As Range

    Dim sStr As String, aStr As String

    Set WB =Workbooks("Pippo.xlsm")                                 '<<===== Modifica

    Set SH = WB.Sheets("Foglio1")                                       '<<===== Modifica

    sStr = Application.UserName & ":"

    Set Rng = SH.UsedRange.SpecialCells(xlCellTypeComments)

    If Not Rng Is Nothing Then

        For Each rCell In Rng.Cells

            With rCell

                aStr = Replace(.Comment.Text, Chr(10), vbNullString)

                If Not aStr = sStr And CBool(Len(aStr)) Then

                        .Interior.ColorIndex = 6

                Else

                    .Interior.ColorIndex = xlNone

                End If

            End With

        Next rCell

    End If

End Sub

'<<==========

===

Regards,

Norman

Answer 2

Ciao Robi,

Ti ringrazio per il tuo gentile riscontro.

===

Regards,

Norman

Answer 3

Chiedo scusa per il disagio creato inserendo questo post come discussione anziché come domanda.

E' stato un errore di distrazione "serale"....

A parte le critiche ritengo che sia stata fornita una risposta più che esauriente alla mia domanda.

Quindi il problema è risolto.

Ringrazio Norman David Jones per il tempo che mi dedicato.

Un saluto

Answer 4

Ciao Robi,

Credo che questa sia una domanda anziché una discussione**^[1]^**e io non sono convinto dell'utilità del codice richiesto, ma, alla fine questo è un giudizio che tu deve fare e, quindi, in un modulo standard forse prova qualcosa di genere: 

'======>>

Option Explicit

'------------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim rCell As Range

    Dim sStr As String, aStr As String

    Const myStr As String = "Commento"

    Set WB = Workbooks("Pippo.xlsm")                                        '<<===== Modifica

    Set SH = WB.Sheets("Foglio1")                                               '<<===== Modifica

    sStr = Application.UserName & ":"

    Set Rng = SH.UsedRange.SpecialCells(xlCellTypeComments)

    If Not Rng Is Nothing Then

        For Each rCell In Rng.Cells

            With rCell

                aStr = .Comment.Text

                If Not aStr = sStr Then

                    If Len(aStr) > Len(sStr) + 1 Then

                        If IsEmpty(.Value) Then

                            .Value = myStr

                        End If

                    ElseIf .Value = myStr Then

                        .ClearContents

                    End If

                End If

            End With

        Next rCell

    End If

End Sub

'<<======

===

Regards,

Norman

^[1]^ **Postscriptum:**Vedo che la discussione è stata convertita ad una domanda.

                          Grazie, Vincenzo!