티스토리 뷰

VBA

[Excel ][VBA] comment 추가

어린왕자1234 2021. 11. 14. 21:22

출처 : 프리렉 / 엑셀 VBA 바이블 / 이현곤 구미숙 저

         WIELY / Excel 2016 Power Programming with VBA / John Walkenbach

 

숫자가 아닌 셀의 데이터는 0으로 처리하고 기존 데이터는 메모장에 저장 보관

comment.xlsm
0.02MB

Private Sub comment_Click()
    Dim r, rng As Range
    
    
    '영역 이름지정으로 설정 가능 => Set rng = Range("판매")
    Set rng = Range("b4:d15")
    
    For Each r In rng
        '셀의 값이 숫자인지 판단
        If IsNumeric(r) <> True Then
            '메모 추가
            r.AddComment ("[기존데이터]")
            With r.comment
                .Visible = False
                '셀의 값을 메모에 추가
                .Text Text:=r.comment.Text & Chr(10) & r.Value
            End With
            r.Value = 0
        End If

    Next r
    
End Sub

comment object.xlsm
0.03MB

Option Explicit

Sub CountComments()
    Dim CommentCount As Integer
    Dim cell As Range
    Dim x As String
    
'   Exit if no comments
    CommentCount = 0
    For Each cell In ActiveSheet.UsedRange
        On Error Resume Next
        x = cell.Comment.Text
        If Err = 0 Then CommentCount = CommentCount + 1
    Next cell
    If CommentCount = 0 Then
        MsgBox "The active worksheet has no comments.", vbInformation
    Else
        MsgBox "The active worksheet contains " & CommentCount & " comments.", vbInformation
    End If
End Sub

Sub SelectCommentCells()
    Cells.SpecialCells(xlCellTypeComments).Select
End Sub

Sub ToggleComments()
    If Application.DisplayCommentIndicator = xlCommentAndIndicator Then
        Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Else
        Application.DisplayCommentIndicator = xlCommentAndIndicator
    End If
End Sub
Sub ListComments()
    Dim CommentCount As Integer
    Dim cell As Range
    Dim x As String
    Dim CommentSheet As Worksheet
    Dim OldSheets As Integer
    Dim Row As Integer
    
'   Exit if no comments
    CommentCount = 0
    For Each cell In ActiveSheet.UsedRange
        On Error Resume Next
        x = cell.Comment.Text
        If Err = 0 Then CommentCount = CommentCount + 1
    Next cell
    If CommentCount = 0 Then
        MsgBox "The active worksheet does not contains any comments.", vbInformation
        Exit Sub
    End If
    
'   Create new workbook with one sheet
    On Error GoTo 0
    Set CommentSheet = ActiveSheet
    OldSheets = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Workbooks.Add
    Application.SheetsInNewWorkbook = OldSheets
    ActiveWorkbook.Windows(1).Caption = "Comments for " & CommentSheet.Name & " in " & CommentSheet.Parent.Name
    
'   List the comments
    Row = 1
    Cells(Row, 1) = "Address"
    Cells(Row, 2) = "Contents"
    Cells(Row, 3) = "Comment"
    Range(Cells(Row, 1), Cells(Row, 3)).Font.Bold = True
    For Each cell In CommentSheet.UsedRange
        On Error Resume Next
        x = cell.Comment.Text
        If Err = 0 Then
            Row = Row + 1
            Cells(Row, 1) = cell.Address(rowabsolute:=False, columnabsolute:=False)
            Cells(Row, 2) = " " & cell.Formula
            Cells(Row, 3) = cell.Comment.Text
        End If
    Next cell
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 34
    Cells.EntireRow.AutoFit
End Sub

Sub ChangeColorofComments()
'   Change colors randomly
    Dim cmt As Comment
    For Each cmt In ActiveSheet.Comments
        cmt.Shape.Fill.ForeColor.SchemeColor = Int((80) * Rnd + 1) '1-80
        cmt.Shape.TextFrame.Characters.Font.ColorIndex = Int((56) * Rnd + 1) '1-56
    Next cmt
End Sub