将数据从列表框导出到 Excel
Export data from Listbox to Excel
我正在尝试将列表框中的所有数据复制到 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
您可以使用以下代码将数据复制到剪贴板 - 这不是我的,我之前在网上找到的。将其粘贴到新模块中。
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。确保你没有像调用函数一样调用模块。
我正在尝试将列表框中的所有数据复制到 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
您可以使用以下代码将数据复制到剪贴板 - 这不是我的,我之前在网上找到的。将其粘贴到新模块中。
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。确保你没有像调用函数一样调用模块。