重命名多个形状

Question

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

重命名多个形状

Rename more then one shape

powerpoint

vba

powerpoint-2010