Страницы: 1
RSS
Добавление выбранных элементов Listbox в массив
 
Добрый день!
Подскажите, пожалуйста, как можно реализовать создание массива из значений выбранных элементов Listbox?
В listbox содержатся названия листов книги, часть из которых необходимо систематически копировать, созздавая новую книгу.
Хотелось реализовать копирование с помощью массива.

Заранее спасибо!
 
А в чем именно проблема?
Код покажите?
 
К сожалению, проблема в незнании VBA.
Как добавить в lisbox названия всех листов - дошло, а как сделать теперь массив из выделенных - не знаю.

Начало:
Код
Private Function GetItemText(ByVal i As Integer) As String 
For i = 0 To ListBox1.Items.Count
   If ListBox1.Items(i).Selected = True Then
GetItemText = CStr(ListBox1.Items(i))
...
Next
   
 
И где же массив? Функция объявлена как строка. Массива нигде не видать...
Код
Function GetItemText()
    Dim i As Long
    Dim lcnt As Long    'счетчик для массива
    Dim avArr()    'массив

    For i = 0 To ListBox1.Items.Count
        If ListBox1.Items(i).Selected = True Then
            ReDim Preserve avArr(lcnt)
            avArr(lcnt) = CStr(ListBox1.Items(i))
        End If
    Next
    'обязательно возвращаем значение массива функции
    GetItemText = avArr
End Function
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
если нужно именно массивом, то:
Код
Private Function Getselected(lbx As Object) As Variant
Dim i&, ind&(), n&
For i = 0 To lbx.items.Count
   If listbox1.items(i).Selected = True Then
        n = n + 1
        ReDim Preserve ind(1 To n)
        ind(n) = i
   End If
Next
Getselected = ind
End Function
Sub test()
    Dim st, x, xi, i&
    xi = Getselected(listbox1)
    ReDim st(1 To UBound(xi))
    For Each x In xi
        i = i + 1
        st(i) = listbox1.items(x).Text
    Next x
End Sub
ps не отлаживал ( от лажать)
Изменено: Слэн - 02.03.2015 15:16:40
Живи и дай жить..
 
 Почему-то выдает ошибку на строке:
Код
For i = 0 To ListBox1.Items.Count
А именно "Method or data member not found"
Изменено: Ms-Matt - 02.03.2015 15:28:49
 
Прошу заметить - все здесь использовали предоставленный Вами код с тем самым ListBox1.
Есть маленькое подозрение, что код Вы расположили ни разу не в модуле формы, а очень даже в стандартном модуле, в котором, конечно же, нет никакого ListBox
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, да, вы правы, видимо.
Как тогда правильно расположить?
вот как оно сейчас все выглядит:
Код
Private Sub CommandButton1_Click()
'Function GetItemText()
    Dim i As Long
    Dim lcnt As Long
    Dim avArr()
 
    For i = 0 To ListBox1.Items.Count
        If ListBox1.Items(i).Selected = True Then
            ReDim Preserve avArr(lcnt)
            avArr(lcnt) = CStr(ListBox1.Items(i))
        End If
    Next
    GetItemText = avArr
Sheets(Array(avArr)).Select

'End Function
End Sub


Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim strWsName$
Dim i%
With Application
    '.Calculation = xlCalculationManual
    .ScreenUpdating = False
    i = 0
    With ActiveWorkbook
        For Each ws In .Worksheets
        If ws.Visible = True Then
        Worksheets("Недели").Cells(1, 17).Offset(i, 0) = ws.Name
        i = i + 1
        End If
        Next
    End With
.ScreenUpdating = True
'.Calculation = xlCalculationAutomatic
End With

 
With ListBox1
For i = 1 To 20
'If Not IsEmpty(Ëèñò2.Cells(i, 17)) Then
.AddItem Worksheets("Недели").Cells(i, 17)
Next
End With

End Sub
Изменено: Ms-Matt - 02.03.2015 15:33:44
 
Помогите пожалуйста объединить эти два кусочка:

1. Определяет и вывод в листбокс, какие есть листы в книге
Код
 
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim strWsName$
Dim i%
With Application
    '.Calculation = xlCalculationManual
    .ScreenUpdating = False
    i = 0
    With ActiveWorkbook
        For Each ws In .Worksheets
        If ws.Visible = True Then
        Worksheets("Недели").Cells(1, 17).Offset(i, 0) = ws.Name
        i = i + 1
        End If
        Next
    End With
.ScreenUpdating = True
'.Calculation = xlCalculationAutomatic
End With
 
  
With ListBox1
For i = 1 To 20
'If Not IsEmpty(Лист2.Cells(i, 17)) Then
.AddItem Worksheets("Недели").Cells(i, 17)
Next
End With
 
End Sub

2.Создает массив с выбранными листами в листбоксе для последующего копиравания их в новую книгу
Код
Private Sub CommandButton1_Click()
'Function GetItemText()
    Dim i As Long
    Dim lcnt As Long
    Dim avArr()
  
    For i = 0 To ListBox1.Items.Count
        If ListBox1.Items(i).Selected = True Then
            ReDim Preserve avArr(lcnt)
            avArr(lcnt) = CStr(ListBox1.Items(i))
        End If
    Next
    GetItemText = avArr
Sheets(Array(avArr)).Select
 
'End Function
End Sub
Сейчас выдает ошибку, пишет, что  "Method or data member not found"
Изменено: Ms-Matt - 02.03.2015 18:04:08
Страницы: 1
Наверх