重命名多个形状

Question

我有用于重命名形状的宏，但它只适用于一个形状对象。我想创建宏来重命名所有选定的形状或将是完美的，如果我可以选择一个多形状，运行宏，InputBox回到我的每个形状并重新命名它。这可能创造吗？有人能帮助我吗？ 在此先感谢

Sub RenameShape() 
    Dim objName 

    On Error GoTo CheckErrors 

    If ActiveWindow.Selection.ShapeRange.Count = 0 Then 
     MsgBox "You need to select a shape first" 
     Exit Sub 
    End If 
    objName = ActiveWindow.Selection.ShapeRange(1).Name 
    objName = InputBox$("Assing a new name to this shape", "Rename Shape", objName) 

    If objName <> "" Then 
     ActiveWindow.Selection.ShapeRange(1).Name = objName 
    End If 

    Exit Sub 

    CheckErrors: 
     MsgBox Err.Description 

End Sub 

Answer 1

添加一个循环来处理每个形状：

Sub RenameShape() 

    ' it's best to dim variables as specific types: 
    Dim objName As String 
    Dim oSh As Shape 

    On Error GoTo CheckErrors 

    With ActiveWindow.Selection.ShapeRange 
     If .Count = 0 Then 
      MsgBox "You need to select a shape first" 
      Exit Sub 
     End If 
    End With 

    For Each oSh In ActiveWindow.Selection.ShapeRange 

     objName = oSh.Name 
     objName = InputBox$("Assign a new name to this shape", "Rename Shape", objName) 
     ' give the user a way out 
     If objName = "QUIT" Then 
      Exit Sub 
     End If 

     If objName <> "" Then 
      oSh.Name = objName 
     End If 
    Next 

    Exit Sub 

CheckErrors: 
     MsgBox Err.Description 

End Sub