按用户选择填充许多选定形状的颜色

Question

选择多个形状后，此代码提示每个选定的形状填充颜色。

Sub ChangeColorBasedonInput()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer

myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)

On Error Resume Next

z = ActiveWindow.Selection.ShapeRange.Count

For x = 1 To z
    With ActiveWindow.Selection.ShapeRange(x)
        colorChoice = InputBox("Please select the color you want for Shape " & x & ", from 1 - 10")
        .Fill.ForeColor.RGB = myColor(colorChoice)
    End With
Next x

End Sub

这是一个麻烦，要一一输入颜色选择，所以我尝试编写代码以输入填充颜色选择（从上面的数组中，它将填充形状。
例如，当我选择7时，填充来自MyColor（7）的形状。

Sub ChangeColorBasedon_EnterOnceOnly()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer

myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)

On Error Resume Next

z = ActiveWindow.Selection.ShapeRange.Count

colorChoice = InputBox("Please select the color you want for Shape " & x + 1 & ", from 1 - 10")

For x = 1 To z
    With ActiveWindow.Selection.ShapeRange(x)
        .Fill.ForeColor.RGB = myColor(colorChoice)
    End With
    colorChoice = colorChoice + x
Next x

End Sub

Answer 1

在下一个X添加之前

If colorChoice > UBound(myColor) Then colorChoice = LBound(myColor) 

，如果选择了太多形状，则可能超过数组的界限