複数の図形の名前を変更します

Question

図形の名前を変更するマクロがありますが、1つの図形オブジェクトに対してのみ機能します。マクロを作成して、選択したすべての図形の名前を変更したい場合またはは複数の図形を選択してマクロを実行し、各図形について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