Экспорт данных из Listbox в Excel

Question

Я пытаюсь скопировать все данные из выпадающего списка в Excel (в идеале я хотел бы просто скопировать его в буфер обмена, но не знаете, как)

Во всяком случае, ниже мой код, который бросает наша эта ошибка:

User-defined type not defined

код ниже:

Dim oExcel As Excel.Application             ' Excel Application 
Set oExcel = New Excel.Application            ' Start it 
oExcel.Workbooks.Open "J:\Book2.xlsx" ' **** CHANGE NAME HERE **** Open it. 

On Error GoTo kill_task 
Col = Listbox31.ColumnCount              ' Number of Columns 
Row = Listbox31.ListCount               ' Number of Rows 


For c = 1 To UBound(Col)               ' For each Column 
    For L = 1 To UBound(Row)              ' in Each Line 
     oExcel.Cells(j, i) = Listbox31.List(j - 1, i - 1)       ' Write the value for Line, Columns 
    Next L                  ' Next Line 
Next c                   ' Next Col 


     oExcel.ActiveWorkbook.Save             ' Save 
     oExcel.Workbooks(1).Close             ' Close Workbook 
     oExcel.Application.Quit             ' Close Application 
Exit Function 

kill_task: 
     oExcel.ActiveWorkbook.Save             ' Save 
     oExcel.Workbooks(1).Close             ' Close Workbook 
     oExcel.Application.Quit              ' Close Application 
End Function 

Answer 1

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

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ 
    As Long 
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ 
    As Long 
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _ 
    ByVal dwBytes As Long) As Long 
Declare Function CloseClipboard Lib "User32"() As Long 
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _ 
    As Long 
Declare Function EmptyClipboard Lib "User32"() As Long 
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ 
    ByVal lpString2 As Any) As Long 
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _ 
    As Long, ByVal hMem As Long) As Long 

Public Const GHND = &H42 
Public Const CF_TEXT = 1 
Public Const MAXSIZE = 4096 

Function ClipBoard_SetData(MyString As String) 
    Dim hGlobalMemory As Long, lpGlobalMemory As Long 
    Dim hClipMemory As Long, X As Long 

    ' Allocate moveable global memory. 
    '------------------------------------------- 
    hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) 

    ' Lock the block to get a far pointer 
    ' to this memory. 
    lpGlobalMemory = GlobalLock(hGlobalMemory) 

    ' Copy the string to this global memory. 
    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) 

    ' Unlock the memory. 
    If GlobalUnlock(hGlobalMemory) <> 0 Then 
     MsgBox "Could not unlock memory location. Copy aborted." 
     GoTo OutOfHere2 
    End If 

    ' Open the Clipboard to copy data to. 
    If OpenClipboard(0&) = 0 Then 
     MsgBox "Could not open the Clipboard. Copy aborted." 
     Exit Function 
    End If 

    ' Clear the Clipboard. 
    X = EmptyClipboard() 

    ' Copy the data to the Clipboard. 
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) 

OutOfHere2: 

    If CloseClipboard() = 0 Then 
     MsgBox "Could not close Clipboard." 
    End If 

    End Function 

Для использования просто поместите ClipBoard_SetData (strYourString) в свой VBA. Убедитесь, что вы не вызываете модуль так же, как функция.