Excel VBA添加新行腳本不會根據按鈕的位置添加行

Question

我有一個excel電子表格，我在行上添加了一個按鈕，我想單擊它，然後複製該行，然後複製下。

由於某種原因，它似乎沒有選擇我點擊按鈕的行，但是光標所在的位置意味着複製了錯誤的行。

有沒有什麼辦法可以改變下面的操作來使按鈕剛被按下的活動單元格？

Sub InsertRows() 
Dim x As Integer 
    x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) 
    If x = False Then Exit Sub 
    ActiveCell.EntireRow.Copy 
    Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown 
    Application.CutCopyMode = False 
End Sub 

提前感謝

人族

編輯

我與托馬斯的幫助下最終解決方案。

略有不同的是，這允許按鈕自己也被複制以及行。

Sub InsertRows() 


    Dim iRow As Integer 
    Dim x As Integer 
    Dim i As Integer 

    x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) 
    iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 
    If x = False Then Exit Sub 

    For i = 0 To (x - 1) 


    'Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown 


    Range("A" & iRow).EntireRow.Copy 
    Range("A" & iRow + 1 + i).EntireRow.Insert Shift:=xlDown 

    Next i 
    Application.CutCopyMode = False 

End Sub 

Answer 1

使用此得到你剛纔點擊的按鈕行：

ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 

我真的不明白你正在嘗試與你的msgbox收集的偏移做。因此，這裏的代碼做excatly你問什麼，即複製行，所述按鈕，該行正下方：

Sub Button1_Click() 

    Dim iRow As Integer 
    iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 
    Range("A" & iRow).EntireRow.Copy 
    Range("A" & iRow + 1).PasteSpecial 

End Sub 

---

編輯： 如果要多次複製，它只是做到這一點：

Sub Button1_Click() 

    Dim iRow As Integer 
    Dim x As Integer 
    Dim i As Integer 

    x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) 
    iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 

    For i = 0 To (x - 1) 

     Range("A" & iRow).EntireRow.Copy 
     Range("A" & iRow + 1 + i).PasteSpecial 

    Next i 

End Sub