Как создать MSForms ListBox в Worksheet, используя VBA? - PullRequest
Новая
       79

Как создать MSForms ListBox в Worksheet, используя VBA?

2 голосов
/ 16 января 2020

Я пытаюсь создать список типа MSForms.ListBox программно с помощью VBA.

Я не могу сделать это с Set ListBox = New MSForms.ListBox, потому что он выдает ошибку компиляции: Invalid use of the New keyword.

В приведенном ниже коде, когда я создаю OLEObject в Macro1, он создает VBAProject.Sheet1.ListBox1 (или другое число), которое я могу затем (после выполнения закончено) присвойте Macro2 переменной типа MSForms.ListBox, но она работает только в том случае, если я запускаю по одному макросу за раз.

С помощью MSForms.ListBox я могу изменить свойства, например ListBox.ColumnHeads = True (даже хотя я не знаю, как изменить значение заголовка, кроме адресации значений списка в диапазон с ListBox.ListFillRange = RangeAddress).

Если я пытаюсь выполнить код шаг за шагом, я получаю сообщение Can't enter break mode at this time.

Я получил OLEObject от записи макроса и вставив элемент управления ActiveX List Box . 

' Microsoft Excel 2013 built-in references:
' Excel - Microsoft Excel 15.0 Object Library
' VBA - Visual Basic For Applications

' VBA project library:
' VBAProject

' Aditional references:
' MSForms - Microsoft Forms 2.0 Object Library

Private Sub Macro1()

  Dim Worksheet As Excel.Worksheet
  Dim ListBox As Excel.ListBox
  Dim Shape As Excel.Shape
  Dim OLEObject As Excel.OLEObject

  Set Worksheet = VBAProject.Sheet1
  Worksheet.Range("A1").Value = "Header"
  Worksheet.Range("A2").Value = "Value 1"
  Worksheet.Range("A3").Value = "Value 2"
  Worksheet.Range("A4").Value = "Value 3"

  For Each Shape In Worksheet.Shapes
    Shape.Delete
  Next Shape

  Set ListBox = Worksheet.ListBoxes.Add(60, 10, 100, 100)
  ListBox.List = Array("Header", "Value 1", "Value 2", "Value 3")
  ListBox.ListFillRange = "A1:A4"

  Set OLEObject = Worksheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, Left:=170, Top:=10, Width:=100, Height:=100)
  OLEObject.ListFillRange = "A1:A4"

  Set Shape = Worksheet.Shapes.AddOLEObject(ClassType:="Forms.ListBox.1", Link:=False, Left:=280, Top:=10, Width:=100, Height:=100)

End Sub

Private Sub Macro2()

  Dim Worksheet As Excel.Worksheet
  Dim ListBox As MSForms.ListBox

  Set Worksheet = Excel.Application.ActiveSheet

  Set ListBox = VBAProject.Sheet1.ListBox1
  ListBox.ListFillRange = ""
  ListBox.List = Array("Header", "Value 1", "Value 2", "Value 3")
  ListBox.ColumnHeads = True
  ListBox.ListFillRange = "A1:A4"
  ListBox.BorderStyle = MSForms.fmBorderStyle.fmBorderStyleSingle

End Sub

Редактировать:

Простой рабочий пример с использованием решения, приведенного в принятом ответе: 

Private Function CreateListBox( _
  Optional ByVal Worksheet As Excel.Worksheet = Nothing, _
  Optional ByVal Width As Long = 100, _
  Optional ByVal Height As Long = 100, _
  Optional ByVal Left As Long = 0, _
  Optional ByVal Top As Long = 0 _
  ) As MSForms.ListBox

  Const ClassType As String = "Forms.ListBox.1"

  If Worksheet Is Nothing Then
    Set Worksheet = Excel.Application.ActiveSheet
  End If

  Set CreateListBox = Worksheet.OLEObjects.Add( _
    ClassType, _
    Left:=Left, _
    Top:=Top, _
    Width:=Width, _
    Height:=Height).Object

End Function

Private Sub Test()

  Dim ListBox As MSForms.ListBox

  Set ListBox = CreateListBox
  Stop ' Able to stop/suspend code execution here but not inside the function when creating the OLEObject

End Sub

1 Ответ

3 голосов
/ 16 января 2020

Когда вы нажмете . в блоке кода With lb...End With, вы увидите, что intellisense не раскрывает некоторые свойства, например .ColumnHeads, .BorderStyle или .List. Вы можете получить доступ к этим свойствам, добавив к ним префикс .Object

Это то, что вы пытаетесь? 

Sub Sample()
    Dim lb As OLEObject
    Dim ws As Worksheet

    Set ws = Sheet1

    For Each lb In ws.OLEObjects
        lb.Delete
    Next lb

    Set lb = ws.OLEObjects.Add(ClassType:="Forms.ListBox.1", _
                               Top:=60, _
                               Left:=10, _
                               Height:=100, _
                               Width:=100)

    With lb
        .ListFillRange = "'" & ws.Name & "'!A1:A16" '<~~ Change range here
        '.Object.List = Array("Header", "Value 1", "Value 2", "Value 3")
        .Object.ColumnHeads = True
        .Object.BorderStyle = MSForms.fmBorderStyle.fmBorderStyleSingle
    End With
End Sub

В действии

enter image description here

...