Изменить размер выбранных фигур powerpoint VBA

Question

Я создаю макрос, который должен изменить размеры выбранных фигур. Я создал с циклом, поэтому поле ввода появится для каждой фигуры, и это отлично работает, но проблема в том, что это ничего не меняет. Любые предложения почему?

Большое вам спасибо.

С уважением!

Sub размер()

Dim objHeigh As Integer 
Dim objWidth As Integer 
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 

    objHeigh = oSh.Height 
    objWidth = oSh.Width 

    objHeigh = InputBox$("Assign a new size of Height", "Heigh", objHeigh) 
     ' give the user a way out 
    If objName = "QUIT" Then 
     Exit Sub 
    End If 

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

objWidth = InputBox$("Assign a new size of Width", "Width", objWidth) 
     ' give the user a way out 
    If objName = "QUIT" Then 
     Exit Sub 
    End If 

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


Exit Sub 

CheckErrors: MsgBox Err.Description

End Sub

Answer 1

Причина ничего не происходит, то, что вы делаете случайные вещи с переменными.

После код будет исправить:

Sub test() 

Dim objHeigh As Integer 
Dim objWidth As Integer 
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 

    objHeigh = oSh.Height 
    objWidth = oSh.Width 

    objHeigh = CInt(InputBox$("Assign a new size of Height", "Heigh", objHeigh)) 
     ' give the user a way out 
    If objHeigh = 0 Then 
     Exit Sub 
    End If 

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


objWidth = CInt(InputBox$("Assign a new size of Width", "Width", objWidth)) 
     ' give the user a way out 
    If objWidth = 0 Then 
     Exit Sub 
    End If 


oSh.Height = CInt(objHeigh) 
oSh.Width = CInt(objWidth) 
Next 
Exit Sub 

CheckErrors: MsgBox Err.Description 

End Sub 

EDIT: Updateed код с Cast к Int. Тип несоответствия не может быть удален

EDIT2: Еще несколько исправлений. Это решение работает так, как планировалось на моей машине