VPF::Как получить данные из буфера обмена в VBA?

motorway

Дата 11.7.2009, 18:24 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 578
Регистрация: 2.3.2008

Репутация: нет
Всего: 0

Как получить данные из буфера обмена в VBA?

--------------------

Russian Pascal Developer Network - Сеть разработчиков на языке программирования Pascal/Object Pascal
Форум Delphi/Kylix, Free Pascal Compiler/Lazarus, PascalABC.NET
Онлайн-кинотеатр

Naghual

Дата 11.7.2009, 19:14 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

Вот тебе мой шаблон для работы с Буфером.
Подправь по необходимости.

Код


Option Explicit

Private Declare Function IsClipboardFormatAvailable _
    Lib "user32" _
    (ByVal uFormat As Long) As Long
Private Declare Function OpenClipboard _
    Lib "user32" _
    (ByVal Hwnd As Long) As Long
Private Declare Function GetClipboardData _
    Lib "user32" _
    (ByVal uFormat As Long) As Long
Private Declare Function GlobalSize _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare Function GlobalLock _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal strDest As Any, _
    ByVal lpSource As Any, _
    ByVal Length As Long)
Private Declare Function GlobalUnlock _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare Function CloseClipboard _
    Lib "user32" () As Long
Private Declare Function GlobalAlloc _
    Lib "kernel32" _
    (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function EmptyClipboard _
    Lib "user32" () As Long
Private Declare Function SetClipboardData _
    Lib "user32" _
    (ByVal uFormat As Long, ByVal hData As Long) As Long
Private Declare Function GlobalFree _
    Lib "kernel32" _
    (ByVal hMem As Long) As Long

Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Private Const CF_TEXT = 1

'Error return codes from Clipboard2Text
Private Const CLIPBOARDFORMATNOTAVAILABLE = 1
Private Const CANNOTOPENCLIPBOARD = 2
Private Const CANNOTGETCLIPBOARDDATA = 3
Private Const CANNOTGLOBALLOCK = 4
Private Const CANNOTCLOSECLIPBOARD = 5
Private Const CANNOTGLOBALALLOC = 6
Private Const CANNOTEMPTYCLIPBOARD = 7
Private Const CANNOTSETCLIPBOARDDATA = 8
Private Const CANNOTGLOBALFREE = 9

Function SetText(strText As String) As Variant
    Dim varRet As Variant
    Dim fSetClipboardData As Boolean
    Dim hMemory As Long
    Dim lpMemory As Long
    Dim lngSize As Long

    varRet = False
    fSetClipboardData = False

    ' Get the length, including one extra for a CHR$(0)
    ' at the end.
    lngSize = Len(strText) + 1
    hMemory = GlobalAlloc(GMEM_MOVABLE Or _
        GMEM_DDESHARE, lngSize)
    If Not CBool(hMemory) Then
        varRet = CVErr(CANNOTGLOBALALLOC)
        GoTo SetTextDone
    End If

    ' Lock the object into memory
    lpMemory = GlobalLock(hMemory)
    If Not CBool(lpMemory) Then
        varRet = CVErr(CANNOTGLOBALLOCK)
        GoTo SetTextGlobalFree
    End If

    ' Move the string into the memory we locked
    Call MoveMemory(lpMemory, strText, lngSize)

    ' Don't send clipboard locked memory.
    Call GlobalUnlock(hMemory)

    ' Open the clipboard
    If Not CBool(OpenClipboard(0&)) Then
        varRet = CVErr(CANNOTOPENCLIPBOARD)
        GoTo SetTextGlobalFree
    End If

    ' Remove the current contents of the clipboard
    If Not CBool(EmptyClipboard()) Then
        varRet = CVErr(CANNOTEMPTYCLIPBOARD)
        GoTo SetTextCloseClipboard
    End If

    ' Add our string to the clipboard as text
    If Not CBool(SetClipboardData(CF_TEXT, _
        hMemory)) Then
        varRet = CVErr(CANNOTSETCLIPBOARDDATA)
        GoTo SetTextCloseClipboard
    Else
        fSetClipboardData = True
    End If

SetTextCloseClipboard:
    ' Close the clipboard
    If Not CBool(CloseClipboard()) Then
        varRet = CVErr(CANNOTCLOSECLIPBOARD)
    End If

SetTextGlobalFree:
    If Not fSetClipboardData Then
        'If we have set the clipboard data, we no longer own
        ' the object--Windows does, so don't free it.
        If CBool(GlobalFree(hMemory)) Then
            varRet = CVErr(CANNOTGLOBALFREE)
        End If
    End If

SetTextDone:
    SetText = varRet
End Function

Public Function GetText() As Variant
    Dim hMemory As Long
    Dim lpMemory As Long
    Dim strText As String
    Dim lngSize As Long
    Dim varRet As Variant

    varRet = ""

    ' Is there text on the clipboard? If not, error out.
    If Not CBool(IsClipboardFormatAvailable _
        (CF_TEXT)) Then
        varRet = CVErr(CLIPBOARDFORMATNOTAVAILABLE)
        GoTo GetTextDone
    End If

    ' Open the clipboard
    If Not CBool(OpenClipboard(0&)) Then
        varRet = CVErr(CANNOTOPENCLIPBOARD)
        GoTo GetTextDone
    End If

    ' Get the handle to the clipboard data
    hMemory = GetClipboardData(CF_TEXT)
    If Not CBool(hMemory) Then
        varRet = CVErr(CANNOTGETCLIPBOARDDATA)
        GoTo GetTextCloseClipboard
    End If

    ' Find out how big it is and allocate enough space
    ' in a string
    lngSize = GlobalSize(hMemory)
    strText = Space$(lngSize)

    ' Lock the handle so we can use it
    lpMemory = GlobalLock(hMemory)
    If Not CBool(lpMemory) Then
        varRet = CVErr(CANNOTGLOBALLOCK)
        GoTo GetTextCloseClipboard
    End If

    ' Move the information from the clipboard memory
    ' into our string
    Call MoveMemory(strText, lpMemory, lngSize)

    ' Truncate it at the first Null character because
    ' the value reported by lngSize is erroneously large
    strText = Left$(strText, InStr(1, strText, Chr$(0)) - 1)

    ' Free the lock
    Call GlobalUnlock(hMemory)

GetTextCloseClipboard:
    ' Close the clipboard
    If Not CBool(CloseClipboard()) Then
        varRet = CVErr(CANNOTCLOSECLIPBOARD)
    End If

GetTextDone:
    If Not IsError(varRet) Then
        GetText = strText
    Else
        GetText = varRet
    End If
End Function

--------------------

Я желаю всем Счастья!

motorway

Дата 11.7.2009, 19:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 578
Регистрация: 2.3.2008

Репутация: нет
Всего: 0

Что-то сложновато для меня. Как просто поместить в переменную содержимое буфера, если что-то дополнительно писать типа функций, куда их помещать, нужно ли дополнительно подключать tools- references?

Типа a=GetFromClipboard()

--------------------

Naghual

Дата 11.7.2009, 23:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

Ничего сложного на самом деле там нет.
Этот код загоняешь в Модуль.
А уже из программы пользуеш его:

SetText(NewText) - для записи текста в буфер;
GetText() - для получения.

--------------------

Я желаю всем Счастья!

motorway

Дата 12.7.2009, 00:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 578
Регистрация: 2.3.2008

Репутация: нет
Всего: 0

Ок, сработало, но там, мне кажется, много лишнего. Лично мне нужно только брать из буфера данные

--------------------

Naghual

Дата 12.7.2009, 01:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

Ну так подправь.

--------------------

Я желаю всем Счастья!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »