Страницы: 1
RSS
VBA. При вставке данных из буфера обмена вставляются 2 квадрата
 
Доброго всем дня.
Возникла проблема, которая возникает только  у пользователей с Windows 10, в Windows 7 все работает. Есть userfom c кнопками, на которые зашиты коды, которые копируют данные из texbox в буфер обмена и затем данные вставляются в другую программу. Ниже коды которые пробовали, но с ними все равно у кого-то появляются сразу квадраты при вставке, у кого-то периодически. Помогите понять в чем проблема и как можно ее решить.

Первый вариант кода:
Код
 'Создание и VBA-наименование объекта "DataObject".
    Dim myDataObject As New MSForms.DataObject

    'Очистка DataObject.
    myDataObject.Clear

    'Копирование текста в DataObject.
    myDataObject.SetText Text:=TextBox9.Text

    myDataObject.PutInClipboard

Второй вариант кода:
Код
Dim txt$ 'переменная будет хранить комментарий
txt = TextBox18.Text

'Вызываем процедуру которая копирует данные
Call copytext(ByVal txt$)

'Функция копирования
Private Sub SetClipboardText(ByVal txt$)
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText txt$
    .PutInClipboard
    End With
End Sub

'Процедура копирования по принципу ctr+C
Private Sub copytext(ByVal txt$)
    SetClipboardText (txt)
End Sub
 
Пример можно увидеть?
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
Небольшой пример, т.к. у меня Windows 7, данная проблема у меня не воспроизводится(
 
Windows 10 - проблема не воспроизводится. Текст  из буфера вставляется корректно. Пробовал вставку в Excel, Word, Блокнот.
 
Как я поняла ошибка плавающая, у некоторых пользователей она возникает периодически, у некоторых ее нет совсем. Можно ли изменить способ переноса текста в буфер на другой более стабильный без таких побочных ошибок как квадраты

Формируемые комментарии в texbox содержат различные символы - []#;,. цифры, текст на английском и русском, даты может это тоже как-то влияет
 
у нас, на курсах трактористов, был аналогичный случай, но вставлялось 3 квадрата
извините, не помню как выпутались из ситуации
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
elena_VVV написал:
проблема, которая возникает только  у пользователей с Windows 10

Цитата
Юрий М написал:
Windows 10 - проблема не воспроизводится

Это может так быть.
Проблемы стали появляться после выхода одного (какого ??? ... : ( ...  ) из обновлений Win8 и продолжаются до сих пор (Win10).
Проблемы с доступом к буферу обмена обнаруживаются только на некоторых компьютерах.

Например в гугле:

"problem with vba with clipboard win 10"
"Clipboard copy VBA code not working in Windows 10"

https://social.msdn.microsoft.com/Forums/en-US/3e52d53f-2c33-425f-a561-41b3c184006c/msforms-dataobje...
https://stackoverflow.com/questions/35416662/text-to-clipboard-in-vba-windows-10-issue
https://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/
https://www.mrexcel.com/forum/excel-questions/1066023-copy-clipboard-vba-problems.html

и т.д.

Вам может понадобиться использовать API:

https://docs.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clip...
https://docs.microsoft.com/en-us/office/vba/access/concepts/windows-api/retrieve-information-from-th...

Изменено: ocet p - 24.08.2019 12:40:56
 
Добрый день! Спасибо ocet p за подборку. Посмотрите, пожалуйста, мы на форуме обсуждали эту тему здесь и здесь.
Изменено: sokol92 - 24.08.2019 14:49:05
Владимир
 
Владимир, ссылки одинаковые :)
 
Юрий, спасибо, исправил (кажется  :) )
Владимир
 
Цитата
sokol92 написал:
мы на форуме обсуждали эту тему
Вы (специалисты) конечно да, но elena_VVV нет, как видно, иначе не было бы темы, это было "адресовано" ей.
Вам я бы не стал писать очевидные вещи - спасибо за ссылки буду читать темы.
 
Коллега ocet p, мне действительно понравилась Ваша подборка из #8, статья Microsoft о копировании в формате CF_UNICODETEXT раньше не попадалась на глаза.
Трудность такого рода тем в том, что мы не можем у себя воспроизвести ситуацию. Может быть, применение Win API и поправит дело, только надо будет откорректировать код для 64-разрядных версий Excel.
Изменено: sokol92 - 24.08.2019 17:33:45
Владимир
 
Всем спасибо за помощь, буду пробовать описанные методы, надеюсь, что-нибудь поможет
 
Елена, посмотрите, пожалуйста, экспериментальное лекарство.
Владимир
 
Спасибо Владимир за помощь, у проблема решилась с вот этим кодом:

Вставляю в модуль:
'Используем вызовы API Windows для переноса данных в буфер обмена
Код
#If VBA7 Then
   Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
 Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As LongPtr
 Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As LongPtr
 Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
 Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
 Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
 Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As LongPtr
 Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
 Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
 Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
 Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr
 #Else
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Public Sub SetClipboard(sUniText As String)
#If Win64 Then
    Dim iStrPtr As LongPtr
    Dim iLen As LongPtr
    Dim iLock As LongPtr
#Else
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
#End If
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Вызываю функцию:

'Вызываем функцию которая копирует данные
SetClipboard Text
 
elena_VVV, посмотрите, как теперь выглядит Ваш код. В следующий раз сами оформляйте подобным образом.
Страницы: 1
Наверх