Drawing Rectagles На Excel, вся строка, «ошибка во время выполнения:" 1004»

Question

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

Я хочу сделать два Прямоугольников: Первых на левую сторону от выбранной ячейки (код не предназначен для первого столбца «А») Вторая справа сторона выбранной ячейки (код не предназначен для последней колонки «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 

Следующий код представляет "Ошибка времени выполнения: '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" & 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