25
Октябрь
2009
Копирование и вставка текста в MSFlexGrid
Копирование и вставка текста в MSFlexGrid
Sub CopyClipboard()
On Error Resume Next
Dim xStart As Integer, yStart As Integer
Dim xEnd As Integer, yEnd As Integer
Dim i As Integer, j As Integer
Dim strClipboard As String
With Screen.ActiveForm.ActiveControl
'координаты верхнего левого угла диапазона копирования
xStart = .Col
yStart = .Row
'координаты нижнего правого угла диапазона копирования
xEnd = .ColSel
yEnd = .RowSel
'Подготовка данных для копирования
'=================================
For i = yStart To yEnd
For j = xStart To xEnd
strClipboard = strClipboard & (.TextMatrix(i, j)) & vbTab
Next
'Удаляем замыкающий символ табуляции
strClipboard = Mid(strClipboard, 1, Len(strClipboard) - 1)
'Перенос строки
strClipboard = strClipboard & vbCrLf
Next
'Удаляем замыкающий символ переноса строки
strClipboard = Mid(strClipboard, 1, Len(strClipboard) - 1)
'=================================
'Очистка буфера
Clipboard.Clear
'Копирование в буфер
Clipboard.SetText strClipboard
End With
End Sub
Теперь можно вставить данные в Excel (стандартными методами) или в другой FlexGrid:
Sub PasteClipboard()
On Error Resume Next
Dim currentCountPasteX As Integer, currentCountPasteY As Integer
Dim currentBufferRow As Integer, currentBufferCol As Integer
Dim xStart As Integer, yStart As Integer
Dim xEnd As Integer, yEnd As Integer
Dim xPaste As Integer, yPaste As Integer
Dim countPasteX As Integer, countPasteY As Integer
Dim rowClip() As String, colClip() As String
Dim countRowClip As Integer, countColClip As Integer
With Screen.ActiveForm.ActiveControl
'координаты верхнего левого угла диапазона, выделенного юзером
xStart = .Col
yStart = .Row
'координаты нижнего правого угла диапазона, выделенного юзером
xEnd = .ColSel
yEnd = .RowSel
'Считываем данные из буфера, разделяя их на строки
rowClip = Split(Clipboard.GetText, vbCrLf)
'Количество строк
countRowClip = UBound(rowClip) + 1
'Проверка буфера
If countRowClip = 0 Then
MsgBox "Буфер обмена пуст!"
Exit Sub
End If
'Делим на столбцы первую строку (для определения количества столбцов)
colClip = Split(rowClip(0), vbTab)
countColClip = UBound(colClip) + 1
'Определяем сколько раз можно вставить данные из буфера
'в выделенный диапазон(по аналогии с Excel)
countPasteX = IIf((xEnd - xStart + 1) > countColClip, _
(xEnd - xStart + 1) \ countColClip, 1)
countPasteY = IIf((yEnd - yStart + 1) > countRowClip, _
(yEnd - yStart + 1) \ countRowClip, 1)
'Вставляем данные
For currentCountPasteY = 1 To countPasteY
For currentCountPasteX = 1 To countPasteX
For currentBufferRow = 0 To countRowClip - 1
colClip = Split(rowClip(currentBufferRow), vbTab)
'Строка вставки
yPaste = yStart + (currentCountPasteY - 1) * _
countRowClip + currentBufferRow
'При необходимости добавляем строку в таблицу
If .Rows = yPaste Then .Rows = yPaste + 1
For currentBufferCol = 0 To countColClip - 1
'Столбец вставки
xPaste = xStart + (currentCountPasteX - 1) * _
countColClip + currentBufferCol
'При необходимости добавляем столбец в таблицу
If .cols = xPaste Then .cols = xPaste + 1
'Удаляем возможные символы переноса строки
colClip(currentBufferCol) = Replace(colClip(currentBufferCol), Chr(13), "")
'Удаляем возможные символы возврата каретки
colClip(currentBufferCol) = Replace(colClip(currentBufferCol), Chr(10), "")
'Вставляем
.TextMatrix(yPaste, xPaste) = colClip(currentBufferCol)
Next
Next
Next
Next
'Очистка буфера
Clipboard.Clear
'Выделяем область, в которую были вставлены данные
.RowSel = yStart + countRowClip * countPasteY - 1
.ColSel = xStart + countColClip * countPasteX - 1
End With
End Sub