Excel VBA Macro: проверка содержимого (из буфера обмена?) Перед вставкой

Question

У меня были серьезные проблемы с вставкой данных из разных источников в Excel. Excel старается быть умным и делает глупости. Нам нужны данные в виде текста.

Проблема в том, что у нас много пользователей, и многие из них не имеют большого опыта работы с компьютерами, поэтому просить их использовать правый клик и «Специальная вставка» каждый раз, не вариант.

Я нашел решение в записи макроса, который использует 'Paste Special' и 'text', и переопределении ctrl-v, чтобы использовать эту функцию. Казалось, что он работал идеально, пока я не пометил ячейку, не скопировал ее и не попытался вставить ее. Макрос разбился.

Итак, мне нужна функция, которая может проверить, пытаюсь ли я вставить скопированный текст, а затем использовать эту строку:

 ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
        False

Пока я вставляю отмеченную ячейку, я хочу запустить эту строку (вставить только значение):

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Я не очень опытен в написании макросов VBA для Excel (и надеюсь, что мне никогда не понадобится), поэтому, если у кого-то есть несколько указателей, я был бы очень признателен.

Answer 1

Для доступа к буферу обмена / манипулирования им нужно добавить ссылку на библиотеку Microsoft Forms 2.0 в Project-> References. Затем вы можете использовать класс MSForms.DataObject, который имеет (среди прочего) метод GetFormat, чтобы проверить, содержит ли буфер обмена определенный тип данных.

Это - довольно хорошее введение в обработку буфера обмена с использованием DataObject.

Answer 2

Sub PasteAsText() ' Assign Keyboard Shortcut: Ctrl+v
    Application.ScreenUpdating = False
    Select Case Application.CutCopyMode
        Case Is = False
                On Error Resume Next
                ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
        Case Is = xlCopy
            If Not Range(GetClipboardRange).HasFormula Then
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Else
                ActiveSheet.Paste
            End If
        Case Is = xlCut
            ActiveSheet.Paste
    End Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Function GetClipboardRange() As String
    ' Edited from http://www.ozgrid.com/forum/showthread.php?t=66773
    Dim formats    'Check to make sure clipboard contains table data
    formats = Application.ClipboardFormats
    For Each fmt In formats
        If fmt = xlClipboardFormatCSV Then
            Application.ActiveSheet.Paste Link:=True  'Paste link

            Dim addr1, addr2 As String 'Parse formulas from selection

            addr1 = Application.Substitute(Selection.Cells(1, 1).Formula, "=", "")
            addr2 = Application.Substitute(Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Formula, "=", "")

            GetClipboardRange = addr1 & IIf(addr1 <> addr2, ":" & addr2, "")
            Exit For
        End If
    Next
End Function

Answer 3

Это не самое лучшее решение, но оно технически работает. Просто попробуйте оба.

On Error Resume Next
ActiveSheet.PasteSpecial Format:=Text, Link:=False, DisplayAsIcon:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Answer 4

Рассматривали ли вы сделать ячейки на целевом листе равными тексту? Когда они общие, Excel делает предположение, что вы ожидаете увидеть.

С другой стороны, если вы действительно хотите реализовать Paste Special ...

Нет события "Вставить", которое вы можете поймать - вы поймали каждое место, где может произойти вставка.

Например, вы можете захватить нажатие клавиши CTRL-V, если при запуске книги выдали следующий код (Workbook_Open):

Application.OnKey "^v", "DoMyPaste"

Это вызовет вашу функцию вместо функции вставки Excel. Поместите что-то вроде этого в модуль:

Public Sub DoMyPaste()
    If Selection.[is marked cell] Then
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Else
        ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon _
        := False
    End If
End Sub

Я не проверял это, это скорее грубый набросок. Обратите внимание, что в Selection может быть несколько ячеек, поэтому при проверке отмеченной ячейки необходимо каким-то образом проверять весь диапазон.

Это только верхушка айсберга. Если вы хотите получить полное решение, ознакомьтесь с этой статьей, которая является версией OCD для перехвата всех вызовов Paste:

http://www.jkp-ads.com/Articles/CatchPaste.asp