Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Range (Cells)


Rambler's Top100


Counter CO.KZ


    [1] [2] [3] [4] [5] [6]

  1. Как автоматически создать список, содержащий скопированный в буфер обмена текст ? NEW 05.11.2017
    [1] [2] [3] [4] [5] [6]


  • Ответ : Скачать пример

    Если Вам необходимо, чтобы любой скопированный текст автоматически помещался в ячейки активного рабочего листа, т.е. после запуска макроса, создавался некий список, то просто выполните нижеопубликованный макрос StartCopyTextFromClipboard, а когда потребуется остановить макрос, используйте StopCopyTextFromClipboard.

    Да, и обратите внимание, что копировать текст можно не только в Excel, проще говоря, пользователь может осуществлять копирование и в других программах. Однако в этом случае, если количество символов в скопированном тексте будет превышать 32767, то этот текст будет "разбит", ибо ячейка в Excel не может содержать большее количество символов.
  • 'Необходима следующая ссылка Microsoft Forms 2.0 Object Library
    
    Public iClipboard As New MSForms.DataObject, iRow&
    
    Public Sub StartCopyTextFromClipboard()
        Range("A:A").Clear
        CopyTextFromClipboard
    End Sub
    
    Public Sub CopyTextFromClipboard()
        If Application.ClipboardFormats(1) = xlClipboardFormatText Then
           iClipboard.GetFromClipboard
           iText$ = iClipboard.GetText(1)
           For iCount& = 1 To Len(iText$) Step 32767
               iRow& = iRow& + 1
               Cells(iRow&, 1) = Mid(iText$, iCount&, 32767)
           Next
           iClipboard.SetText "", 1
           iClipboard.PutInClipboard
        End If
        Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard"
    End Sub
    
    Public Sub StopCopyTextFromClipboard()
        On Error Resume Next
        Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard", , False
    End Sub

    Если же задача, в принципе, таже, но заполнять нужно только пустые ячейки конкретного диапазона (в примере это A1:C3), т.е. до выполнения макроса, некоторые ячейки уже могут быть заполнены и данные этих ячеек нужно оставить, а прекратить всё необходимо, как только все ячейки будут заполнены, то :
    'Необходима следующая ссылка Microsoft Forms 2.0 Object Library
    
    Public iClipboard As New MSForms.DataObject
    
    Public Sub CopyTextFromClipboard()
        Dim iSource As Range, iCell As Range, iText$
    
        On Error Resume Next
        iClipboard.GetFromClipboard: iText = iClipboard.GetText(1)
    
        If iText <> "" Then 'If Len(iText) > 0 Then
           Set iSource = ThisWorkbook.Worksheets(1).Range("A1:C3")
           Set iCell = iSource.Find("", , xlFormulas, xlWhole) ', xlByRows)
    
           If Not iCell Is Nothing Then
              iCell.Value = Left(iText, 32767)
              iClipboard.SetText "", 1: iClipboard.PutInClipboard
              Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard"
           End If
        End If
    End Sub

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2017 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff