Как я могу добавить выпадающий список после вставки новой строки в VBA

Question

Я пытаюсь вставить выпадающий список с двумя пунктами после добавления новой строки. Этот код ниже не работает должным образом.

     Dim varUserInput As Variant
     varUserInput = InputBox("Enter Row Number where you want to add a row:", 
    "What Row?")
    If varUserInput = "" Then Exit Sub
    RowNum = varUserInput
    Rows(RowNum + 1).Insert Shift:=xlDown
    With Sheet1.RowNum.listBox1
     .AddItem "Paris"
     .AddItem "New York"
    End With

Answer 1

Попробуй это:

Sub Macro1()

RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")
If RowNum = "" Then Exit Sub

Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="London,Sydney"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
End Sub

Примечание. Большую часть этого я записал с помощью инструмента «Запись макроса» на вкладке «Разработчик», а затем отредактировал для использования частей вашего кода. Это полезный метод, когда вы не уверены, какой именно код требуется для вставки чего-либо, например, этот выпадающий список проверки.

Изменить: чтобы добавить два списка одновременно:

Sub Macro1()
'ask user for row to insert data
RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")
If RowNum = "" Then Exit Sub

'insert dropdowns in column A
Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="London,Sydney"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

'inset second drop down in column E
Range("E1").Offset(RowNum, 0).Select '<-- change reference to E
'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '<-- line removed as don't need to insert twice

With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="New York,Jakarta"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

End Sub

и со многими идентичными списками:

Sub Macro1()
Dim RowNum As Integer
Dim Lists As Integer

'ask user for row to insert data
RowNum = InputBox("Enter Row Number where you want to add a row:", "What Row?")

'insert row
Range("A1").Offset(RowNum, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'ask how many drop down lists to make
Lists = InputBox("Enter number of drop down lists to make in this row:", "Number?")

i = 0

Do While i < Lists And i < 1000
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Hong Kong,Rome,Wellington,Cairo"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

    'move across one cell
    ActiveCell.Offset(0, 1).Range("A1").Select

    i = i + 1
Loop


End Sub