コメントの形を変更

指定したセルのコメントの形を変える。

VBAでセルに付けたコメントの形を標準のものから形を変えたい場合はShapeオブジェクトのAutoShapeTypeプロパティに定数を設定することで変えることができます。

AutoShapeTypeプロパティに設定できる種類は130種類以上ありますが、サンプルコードでは比較的よく使われそうな10種類のコメントの形を記載しています。

'******************************************************************
' セルのコメントの形を変更
'******************************************************************
Sub Main_CommentShape()

    'コメントの追加
    Dim i As Long: Dim j As Long
    i = 1: j = 1
    Do While True
        Call setCellComment(Sheets("Sheet1").Cells(i, 1), "コメント" & j, 0, True)
        j = j + 1
        Call setCellComment(Sheets("Sheet1").Cells(i, 5), "コメント" & j, 0, True)
        j = j + 1
        i = i + 4
        If i > 17 Then: Exit Do
    Loop
        
    'コメントの形を変える
        '標準
        Sheets("Sheet1").Cells(1, 1).Comment.Shape.AutoShapeType = msoShapeRectangle
        
        'ひし形
        Sheets("Sheet1").Cells(5, 1).Comment.Shape.AutoShapeType = msoShapeDiamond
        
        '雲型
        Sheets("Sheet1").Cells(9, 1).Comment.Shape.AutoShapeType = msoShapeCloudCallout
        
        '丸型
        Sheets("Sheet1").Cells(13, 1).Comment.Shape.AutoShapeType = msoShapeOvalCallout
        
        '角丸め
        Sheets("Sheet1").Cells(17, 1).Comment.Shape.AutoShapeType = msoShapeRoundedRectangle
        
        '円
        Sheets("Sheet1").Cells(1, 5).Comment.Shape.AutoShapeType = msoShapeOval
        
        'メモ
        Sheets("Sheet1").Cells(5, 5).Comment.Shape.AutoShapeType = msoShapeFoldedCorner
        
        '爆発
        Sheets("Sheet1").Cells(9, 5).Comment.Shape.AutoShapeType = msoShapeExplosion1
        
        '星(5ポイント)
        Sheets("Sheet1").Cells(13, 5).Comment.Shape.AutoShapeType = msoShape5pointStar
        
        '禁止
        Sheets("Sheet1").Cells(17, 5).Comment.Shape.AutoShapeType = msoShapeNoSymbol
 
End Sub

'******************************************************************
' セルのコメントを追加、編集
'------------------------------------------------------------------
'   第1引数:セルのRangeオブジェクト
'   第2引数:コメント本文
'   第3引数:新規(0) or 追記(0以外)
'   第4引数:表示(True)/非表示(Flase)
'******************************************************************
Sub setCellComment(getCell As Range, getText As String, AddType As Integer, getVisible As Boolean)
    
    '既存コメント有無を確認、ない場合はコメントできるように追加
    If getCell.Comment Is Nothing Then
        getCell.AddComment
    End If
    
    'コメントを追記するか判断
    If AddType = 0 Then
        getCell.Comment.Text getText
    Else
        '追記の場合は既存コメントを変数に退避
        Dim sCmt As String
        sCmt = getCell.Comment.Text
        getCell.Comment.Text sCmt & getText '追記
    End If
    
    'コメントの表示/非表示を指定
    getCell.Comment.Visible = getVisible

End Sub

 ■実行結果