單擊按鈕插入行

我有以下代碼，這是我從這個社區獲得的，它允許我雙擊一個單元格并在下面插入一行。它插入行，然后回傳到 E 到 R 列以及 T 列，并清除內容。

我想要做的就是采用相同的代碼并將其應用于按鈕單擊而不是雙擊（這里的作業人員使用雙擊來編輯單元格）。

雙擊代碼如下：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Target.Offset(1).EntireRow.Insert
    Target.EntireRow.Copy Target.Offset(1).EntireRow
     Intersect(Target.Offset(1).EntireRow, Range("E:R,T:T")).ClearContents
End Sub

我嘗試了其他幾個代碼（在 StackOverflow 上找到），我正要修改這些代碼以回傳 和ClearContents，但我不斷收到錯誤訊息。

我嘗試過的另外兩個代碼是：

Public Sub insertRowBelow()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

和

Sub InsertRow()
r = Selection.Row
Cells(r   1, 1).EntireRow.Insert
Cells(r, 1).Copy Destination:=Cells(r   1, 1)
End Sub

在兩者上，我都收到“未定義變數”錯誤：

The end goal is for the user to click on a cell, click the button, it copies down the formulas from the line above, and then ClearContents in columns E through R, as well as column T (for only that newly inserted row, not ClearContents for the entire column!)

BONUS COOL POINTS: if you're able to make it so they can't add a row if they are above row 5, that'd be fantastic. Rows 1, 2, 3, and 4, are all header / information type rows, so if they click in any of those (or don't know the active cell is up there) and click this button, since you can't undo VBA, it could mess up the header section pretty good. So they would have to activate a cell in row 5 or below for this to work, that would be the icing on the cake.

Triple cool points if we can add a msg box that says "Please select a cell in row 5 or below" so they don't just think the button's broken... that would be the best of the best of the best.

Thanks for any help in advance!!

uj5u.com熱心網友回復：

在下方插入一行

Option Explicit

Sub InsertRowBelow()
    Const ProcTitle As String = "Insert a Row Below"
    
    Const msgRange As String = "Please select a cell."
    Const msgRowMin As String = "Please select a cell below row 4."
    Const msgRowMax As String = "Please select a cell above the last row."
    
    On Error GoTo ClearError ' e.g. worksheet is protected
    
    If TypeName(Selection) = "Range" Then
        With Selection.Cells(1).EntireRow ' consider only the first cell's row
            If .Row > 4 Then
                If .Row < .Worksheet.Rows.Count Then
                    .Copy
                    .Offset(1).Insert xlShiftDown ' , xlFormatFromLeftOrAbove
                    Intersect(.Offset(1), .Worksheet.Range("E:R,T:T")) _
                        .ClearContents ' sets 'Application.CutCopyMode' to False
                Else ' '.Row = .Worksheet.Rows.Count' (last Row)
                    MsgBox msgRowMax, vbCritical, ProcTitle
                End If
            Else ' '.Row <= 4'
                MsgBox msgRowMin, vbCritical, ProcTitle
            End If
        End With
    Else ' 'Selection' is not a range (e.g. it's a shape)
        MsgBox msgRange, vbCritical, ProcTitle
    End If

ProcExit:
    Exit Sub
ClearError:
    MsgBox "Unexpected Error" & vbLf & vbLf _
        & "Run-time error '" & Err.Number & "':" & vbLf _
        & Err.Description, vbCritical, ProcTitle
    'If Application.CutCopyMode Then Application.CutCopyMode = False
    Resume ProcExit
End Sub

標籤：excel vba

上一篇：某些單元格有多行時如何讀取excel檔案

下一篇：當第二個資料頁標題不可用時避免ExcelPowerQuery錯誤