重命名多个形状答案

【问题标题】：Rename more then one shape重命名多个形状
【发布时间】：2016-06-17 22:29:52
【问题描述】：

我有用于重命名形状的宏，但它只适用于一个形状对象。我想创建宏来重命名所有选定的形状 OR 如果我可以选择一个多个形状，运行宏并且 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

【问题讨论】：

标签： vba powerpoint powerpoint-2010

【解决方案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

【讨论】：