копирование существующей строки, которая также копирует флажок с его кодом

Question

когда я нажимаю кнопку, моя таблица должна быть расширена на 1 строку. но также необходимо скопировать флажок и его код. Как мне это сделать, потому что это не работает таким образом? строка, выделенная жирным шрифтом, — это ошибка.

      Private Sub CommandButton2_Click()
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim chkBox As CheckBox
'Determine the last row in the active worksheet
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Determine the last column you want to expand
    lastColumn = 7
'Insert a row above the last row
    Rows(lastRow + 1).Insert
'Copy the formulas from the last row to the new row
    Range(Cells(lastRow, 1), Cells(lastRow, lastColumn)).Copy Range(Cells(lastRow + 1, 1), Cells(lastRow + 1, lastColumn))
'Copy the last checkbox with his VBA code
    Set chkBox = ActiveSheet.CheckBoxes(ActiveSheet.CheckBoxes.Count)
    chkBox.Copy
    ActiveSheet.CheckBoxes.Add(chkBox.Left, chkBox.Top + chkBox.Height + 5, chkBox.Width, chkBox.Height).Select
    ActiveSheet.Paste
End Sub

Answer 1

Во-первых, кажется, что вам не нужна эта строка кода...

      Rows(lastRow + 1).Insert

Во-вторых, поскольку вы добавляете новый флажок, нет необходимости копировать и вставлять его. В противном случае вы бы добавили два новых флажка, а не один.

Поэтому я думаю, что ваш макрос можно переписать следующим образом (возможно, вам придется скорректировать значение, которое вы присваиваете свойству Top CheckBox)...

      Private Sub CommandButton2_Click()
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim chkBox As CheckBox
    Dim newChkBox As CheckBox
'Determine the last row in the active worksheet
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Determine the last column you want to expand
    lastColumn = 7
'Copy the formulas from the last row to the new row
    Range(Cells(lastRow, 1), Cells(lastRow, lastColumn)).Copy Cells(lastRow + 1, 1)
'Copy the last checkbox with his VBA code
    Set chkBox = ActiveSheet.CheckBoxes(ActiveSheet.CheckBoxes.Count)
    Set newChkBox = ActiveSheet.CheckBoxes.Add(chkBox.Left, chkBox.Top + chkBox.Height + 5, chkBox.Width, chkBox.Height)
    With newChkBox
        .Caption = ""
        .OnAction = chkBox.OnAction
    End With
End Sub

Однако есть еще один способ...

      Private Sub CommandButton2_Click()

    Dim lastRow As Long
    Dim lastColumn As Long

    'Determine the last row in the active worksheet
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    'Determine the last column, including the column containing the checkbox
    lastColumn = 8
    
    'Copy the last row to the next row
    Range(Cells(lastRow, 1), Cells(lastRow, lastColumn)).Copy Cells(lastRow + 1, 1)
    
End Sub

Answer 2

Вместо копирования объекта флажка вы можете создать новый на основе существующего. Метод копирования, используемый для объекта CheckBox, не поддерживается в VBA. Private Sub CommandButton2_Click() Dim LastRow As Long Dim LastColumn As Long Dim chkBox As CheckBox Dim newChkBox As CheckBox Dim chkBoxTop As Double

          'Determine the last row in the active worksheet
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    'Determine the last column you want to expand
    lastColumn = 7
    
    'Insert a row above the last row
    Rows(lastRow + 1).Insert
    
    'Copy the formulas from the last row to the new row
    Range(Cells(lastRow, 1), Cells(lastRow, lastColumn)).Copy Range(Cells(lastRow + 1, 1), Cells(lastRow + 1, lastColumn))
    
    'Create a new checkbox based on the last one
    Set chkBox = ActiveSheet.CheckBoxes(ActiveSheet.CheckBoxes.Count)
    chkBoxTop = chkBox.Top + chkBox.Height + 5
    Set newChkBox = ActiveSheet.CheckBoxes.Add(chkBox.Left, chkBoxTop, chkBox.Width, chkBox.Height)
    newChkBox.Caption = chkBox.Caption
    newChkBox.Value = chkBox.Value
    
    'Copy the checkbox code behind it
    newChkBox.OnAction = chkBox.OnAction
    
End Sub

Создайте новый флажок на основе последнего флажка, установите для него одинаковые заголовок и значение и скопируйте код, стоящий за ним.