調整所選形狀的大小Powerpoint VBA

Question

我正在創建應調整所選形狀大小的宏。 我已經創建了循環，因此每個形狀的輸入框都會彈出，效果很好，但是問題是這沒有改變。 有什么建議嗎？

非常感謝。

問候！

子resize（）

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錯誤說明

結束子

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

編輯：使用強制轉換為Int的更新的代碼。 類型不匹配將消失

EDIT2：其他一些修復程序。 該解決方案可以在我的機器上正常工作