开发者

VBA Macro to copy different cell values in a Notepad

开发者 https://www.devze.com 2023-04-01 22:20 出处:网络
I want to copy the different cells data开发者_JAVA技巧 into a notepad. How do i do that. Example : values from row3 column B(B3), then from row3 column E(E3).

I want to copy the different cells data开发者_JAVA技巧 into a notepad. How do i do that. Example : values from row3 column B(B3), then from row3 column E(E3).

Thanks in advance.


Using a helper module you could:

 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

If instead of Range("$B$3,$E$3") you said Selection you'd end up with all the cells currently selected.

Hint: You can select inidivual cells using Ctrl+LeftMouseButton

You need the following helper definitions somewhere in your VBA project (I suggest a module named like '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

Notes

  • code 'borrowed' from http://www.everythingaccess.com/tutorials.asp?ID=Copying-data-to-and-from-the-Clipboard-(Acc-95%2B)
  • tested in Excel 2003 on Windows XP SP3


Write your cell values to a text file, then open it in Notepad or your favourite text editor.

' 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""")
0

精彩评论

暂无评论...
验证码 换一张
取 消