VBAmacros在记事本中复制不同的单元格值
我想将不同的单元格数据复制到记事本中。 我怎么做。 示例：来自row3列B（B3），然后来自row3列E（E3）的值。
提前致谢。
使用助手模块，您可以：
Dim cell As Range Dim concat As String For Each cell In Range("$B$3,$E$3") concat = concat & vbCrLf & cell.Value Next ' Debug.Print concat Text2Clipboard concat
如果您select的是Range("$B$3,$E$3")不是当前所选的所有单元格。
提示 ：您可以使用Ctrl + LeftMouseButton来select单位细胞
你需要在你的VBA项目的某个地方需要下面的帮助器定义（我build议一个名字叫'Clipboard'的模块）：
Declare Function abOpenClipboard Lib "User32" Alias "OpenClipboard" (ByVal Hwnd As Long) As Long Declare Function abCloseClipboard Lib "User32" Alias "CloseClipboard" () As Long Declare Function abEmptyClipboard Lib "User32" Alias "EmptyClipboard" () As Long Declare Function abIsClipboardFormatAvailable Lib "User32" Alias "IsClipboardFormatAvailable" (ByVal wFormat As Long) As Long Declare Function abSetClipboardData Lib "User32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long Declare Function abGetClipboardData Lib "User32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long Declare Function abGlobalAlloc Lib "Kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare Function abGlobalLock Lib "Kernel32" Alias "GlobalLock" (ByVal hMem As Long) As Long Declare Function abGlobalUnlock Lib "Kernel32" Alias "GlobalUnlock" (ByVal hMem As Long) As Boolean Declare Function abLstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function abGlobalFree Lib "Kernel32" Alias "GlobalFree" (ByVal hMem As Long) As Long Declare Function abGlobalSize Lib "Kernel32" Alias "GlobalSize" (ByVal hMem As Long) As Long Const GHND = &H42 Const CF_TEXT = 1 Const APINULL = 0 Function Text2Clipboard(szText As String) Dim wLen As Integer Dim hMemory As Long Dim lpMemory As Long Dim retval As Variant Dim wFreeMemory As Boolean ' Get the length, including one extra for a CHR$(0) at the end. wLen = Len(szText) + 1 szText = szText & Chr$(0) hMemory = abGlobalAlloc(GHND, wLen + 1) If hMemory = APINULL Then MsgBox "Unable to allocate memory." Exit Function End If wFreeMemory = True lpMemory = abGlobalLock(hMemory) If lpMemory = APINULL Then MsgBox "Unable to lock memory." GoTo T2CB_Free End If ' Copy our string into the locked memory. retval = abLstrcpy(lpMemory, szText) ' Don't send clipboard locked memory. retval = abGlobalUnlock(hMemory) If abOpenClipboard(0&) = APINULL Then MsgBox "Unable to open Clipboard. Perhaps some other application is using it." GoTo T2CB_Free End If If abEmptyClipboard() = APINULL Then MsgBox "Unable to empty the clipboard." GoTo T2CB_Close End If If abSetClipboardData(CF_TEXT, hMemory) = APINULL Then MsgBox "Unable to set the clipboard data." GoTo T2CB_Close End If wFreeMemory = False T2CB_Close: If abCloseClipboard() = APINULL Then MsgBox "Unable to close the Clipboard." End If If wFreeMemory Then GoTo T2CB_Free Exit Function T2CB_Free: If abGlobalFree(hMemory) <> APINULL Then MsgBox "Unable to free global memory." End If End Function
笔记
- 代码“借来自” http://www.everythingaccess.com/tutorials.asp?ID=Copying-data-to-and-from-the-Clipboard-(Acc-95%2B ）
- 在Windows XP SP3上的Excel 2003中进行了testing
将您的单元格值写入文本文件，然后在记事本或您最喜爱的文本编辑器中打开它。
' Write to file. Open "C:\temp.txt" For Output As #1 Print #1, Range("B3").Value, Range("C4").Value Print #1, Range("Q981").Value, "hello world!" ' or whatever else Close #1 ' Now open it in notepad. Shell ("notepad ""C:\temp.txt""")