Блог

Я упростил свой код:

Я хочу нарисовать два прямоугольника: первый слева от выбранной ячейки (код не предназначен для первого столбца «А») Вторая справа сторона выбранной ячейки (код не предназначен для последнего столбца «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) amp; MyRow amp; ":" amp; NumToCol(LftCol) amp; MyRow
        RRng = NumToCol(RgtCol) amp; MyRow amp; ":" amp; NumToCol(RgtCol   3) amp; 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
  

Следующий код представляет «Ошибку времени выполнения:’1004′», «Ошибку, определяемую приложением или объектом».

     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" amp; MyRow amp; ":" amp; NumToCol(LftCol) amp; MyRow
        RRng = NumToCol(RgtCol) amp; MyRow amp; ":" amp; "XFD" amp; 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
  

Но я не могу понять, что является реальной ошибкой во втором коде:

Ваш RRng слишком большой. RngRht.Width равно 785712. Попробуйте уменьшить ее, уменьшив диапазон. Я изменил XFD на FD, чтобы уменьшить его. Вы можете изменить это в соответствии с вашими потребностями в коде.

 RRng = NumToCol(RgtCol) amp; MyRow amp; ":" amp; "FD" amp; MyRow