Question

我正在创建应调整所选形状大小的宏。我已经创建了循环，因此每个形状都会弹出输入框，这样可以正常工作，但问题是这不会改变任何东西。有什么建议吗？

非常感谢你。

问候！

Sub 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 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

编辑：使用Cast转换为Int更新的代码。类型不匹配应该消失

EDIT2：更多补救措施。此解决方案在我的机器上按预期工作

调整所选形状的尺寸powerpoint VBA

1 个答案: