Drawing Rectagles On Excel, Entire Row, "Run-time error :'1004'"

Question

我简化了我的代码：

我想画两个矩形：所选单元格的第一个到左侧（代码不适用于第一个 "A" 列）所选单元格右侧的第二个（代码不适用于最后 "XFD" 列）。

两个代码都使用的函数。

    Private Function NumToCol(numCol)
        NumToCol = Split(Cells(, numCol).Address, "$")(1)
    End Function

这是我的代码：

    Sub CreateLateralRectangles()
        'Working no problem

        Dim LftRctl As Shape
        Dim RhtRctl As Shape
        Dim RngRht As Range
        Dim RngLft As Range

        MyRow = ActiveCell.Row
        MyCol = ActiveCell.Column

        LftCol = MyCol - 1
        RgtCol = MyCol + 1

        LRng = NumToCol(LftCol - 3) & MyRow & ":" & NumToCol(LftCol) & MyRow
        RRng = NumToCol(RgtCol) & MyRow & ":" & NumToCol(RgtCol + 3) & MyRow

        Set RngRht = Range(RRng)
        Set RngLft = Range(LRng)

        MsgBox "Beging To Create"
        Set LftRctl = ActiveSheet.Shapes.AddShape(msoShapeRectangle, RngLft.Left, RngLft.Top, RngLft.Width, RngLft.Height)
        Set RhtRctl = ActiveSheet.Shapes.AddShape(msoShapeRectangle, RngRht.Left, RngRht.Top, RngRht.Width, RngRht.Height)
    End Sub

下一段代码呈现"Run-time error :'1004'""Application-defined or object-defined error"

    Sub CreateFullRectangles()
        'Has problem

        Dim LftRctl As Shape
        Dim RhtRctl As Shape
        Dim RngRht As Range
        Dim RngLft As Range

        MyRow = ActiveCell.Row
        MyCol = ActiveCell.Column

        LftCol = MyCol - 1
        RgtCol = MyCol + 1

        LRng = "A" & MyRow & ":" & NumToCol(LftCol) & MyRow
        RRng = NumToCol(RgtCol) & MyRow & ":" & "XFD" & MyRow

        Set RngRht = Range(RRng)
        Set RngLft = Range(LRng)

        MsgBox "Beging To Create"
        Set LftRctl = ActiveSheet.Shapes.AddShape(msoShapeRectangle, RngLft.Left, RngLft.Top, RngLft.Width, RngLft.Height)
        Set RhtRctl = ActiveSheet.Shapes.AddShape(msoShapeRectangle, RngRht.Left, RngRht.Top, RngRht.Width, RngRht.Height)
    End Sub

但我无法弄清楚第二个代码的真正错误是什么：

Answer 1

您的 RRng 过大。 RngRht.Width等于785712，缩小范围试试看。我将 XFD 更改为 FD 以减少它。您可以根据您的代码需要进行更改。

RRng = NumToCol(RgtCol) & MyRow & ":" & "FD" & MyRow

Drawing Rectagles On Excel, Entire Row, "Run-time error :'1004'"

Drawing Rectagles On Excel, Entire Row, "Run-time error :'1004'"

excel

vba

runtime-error

shape

ms-office