描画Rectaglesでエクセル、行全体、「ファイル名を指定して実行時エラー： 『1004』」

Question

私は自分のコードに簡略化

：私は2つの長方形を描きたい

： 選択したセルの左側（コードへの最初の最初の "A"列には意味がありません） 選択したセルの2番目から右側に（コードは最後の "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 

しかし、私は実際のエラーが何であるか把握することができません。2番目のコード：

Answer 1

RRngが大きすぎます。 RngRht.Widthは785712と同じです。範囲を小さくして縮小してみてください。私はそれを減らすためにXFDをFDに変更しました。コードの必要性に応じて変更することができます。

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

私のマシン上でExcelの可能性RRNGため