怎样使用VBA批量修改批注外观?

1、首先在开发工具中打开VBA编辑器

2、在单元格区域当中输入一些内容作为例子

3、在VBA编辑器中插入模块

4、在模块当中输入如下代码，然后运行

Sub批量修改批注外型()

 

Dim i As Integer, cell As Range, mystr As String

 

If TypeName(Selection) <> "Range" Then MsgBox "请选择单元格!", 64, "

 

      【友情提示】": Exit Sub  '未选中单元格则退出

 

On Error GoTo err   '排错，当工作表中没有批注时会出错

 

mystr=InputBox("输入批注外型" & Chr(10) & "1为口哨型,2为书卷型,3为箭头型" _

 

& Chr(10) & "4为圆角矩形,5为缺角矩形,6为菱型,7为五角星.", "批注外型", 1, 10, 10)

 

      Application.ScreenUpdating=False

 

For Each cell In Selection

 

If Not Application.Intersect(cell, Cells.SpecialCells(xlCellTypeComments))

 

      Is Nothing Then

 

With cell.Comment

 

.Visible=True

 

.Shape.Select True

 

End With

 

With Selection.ShapeRange

 

If mystr=1 Then .AutoShapeType=msoShapeFlowchartSequentialAccessStorage

 

If mystr=2 Then .AutoShapeType=msoShapeFoldedCorner

 

If mystr=3 Then .AutoShapeType=msoShapeRightArrow

 

If mystr=4 Then .AutoShapeType=msoShapeRoundedRectangularCallout

 

If mystr=5 Then .AutoShapeType=msoShapePlaque

 

If mystr=6 Then .AutoShapeType=msoShapeDiamond

 

If mystr=7 Then .AutoShapeType=msoShape5pointStar

 

cell.Comment.Visible=False

 

End With

 

Else

 

i=i+1

 

End If

 

Next

 

Application.ScreenUpdating=True

 

If i=Selection.Count Then MsgBox "选区中没有批注！", 64, "提示"

 

ActiveCell.Select: Exit Sub

err:

 

    MsgBox "本工作表中没有批注！", 64, "提示"

 

End Sub

5、选中任意区域，然后利用快捷键Alt+F8调出运行宏窗口，单击“执行”按钮，程序弹出输入对话框等待输入新批注样式编号