Bucketex.com - Free online notepad

Function 判断注释(ByVal rng As Range) As Boolean
    If rng.Cells(1).Comment Is Nothing Then
        判断注释 = False
        Else: 判断注释 = True  '有注释
    End If
 End Function

Sub 添加注释()
Dim 返回值 As Byte

返回值 = MsgBox("要在该单元格增加注释吗?", vbYesNo + vbQuestion, "PFEI 提醒:")
    If 返回值 = 7 Then
        Exit Sub
    ElseIf 返回值 = 6 Then
            If 判断注释(ActiveCell) = False Then
                ActiveCell.AddComment Text:="提前十分钟关舱"
                ActiveCell.Comment.Visible = True
                Application.OnTime Now + TimeValue("00:00:02"), "隐藏注释"  '延时2秒后调用隐藏注释过程
              Else
                MsgBox "此单元格已有注释"
            End If
       End If
     
End Sub
Sub 隐藏注释()
    ActiveCell.Comment.Visible = False
End Sub
Sub 追加注释()
    If 判断注释(ActiveCell) Then
    ActiveCell.Comment.Text Text:=VBA.vbCrLf & "追加内容", Start:=Len(ActiveCell.Comment.Text) + 1
    End If
End Sub

Sub 修改注释形状()
    If 判断注释(ActiveCell) Then
        ActiveCell.Comment.Shape.AutoShapeType = msoShape8pointStar
    End If
End Sub

Sub 修改注释()
    Dim 注释
    For Each 注释 In Sheets("注释").Comments
            With 注释.Shape.TextFrame.Characters.Font
            .Name = "微软雅黑"
            .Size = 14
            .ColorIndex = 5
            .Bold = False
        End With
    Next
End Sub
Sub 加入图片()
    If 判断注释(ActiveCell) Then
    ActiveCell.Comment.Shape.Fill.UserPicture "c:\xx\xx.jpg"
    End If
    
End Sub