둘 이상의 셰이프 이름 바꾸기

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 

너무 많은이가 나를 위해 작동