Sub AddRowsByFieldValue(StartRow As Integer, ColumnNumber As Integer)
i = StartRow
Do
If Cells(i, ColumnNumber).Value <> 0 Then
NumberOfRowToInsert = Cells(i, ColumnNumber).Value
For j = 1 To NumberOfRowToInsert
Rows(i + j).Select
Selection.Insert Shift:=xlDown
Next
i = i + j
Else
Exit Do
End If
Loop
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call AddRowsByFieldValue(ActiveCell.Row, ActiveCell.Column)
End Sub
Что изменил - код макроса вставил в модуль, вместо запуска по двойному клику создал кнопку
Код
Option Explicit
Const sMenuBarName As String = "Test"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars(sMenuBarName).Delete
End Sub
Private Sub Workbook_Open()
On Error Resume Next
Application.CommandBars(sMenuBarName).Delete
On Error GoTo 0
With Application.CommandBars.Add(sMenuBarName, temporary:=True)
With .Controls.Add
.Caption = "Вставка пустых строк по значению ячейки"
.Style = 3
.FaceId = 2
.OnAction = "AddRowsByFieldValue"
End With
.Visible = True
End With
End Sub
и сохранил как надстройку xla. При подключении надстройки и запуске макроса через кнопку выдается сообщение - "Argument not optional". Где нужно что доработать, что бы ошибка исчезла? Сама надстройка в приложении. Спасибо.