سورس Copy Contents of one MSFlexGrid To Another ویژوال بیسیک

' #VBIDEUtils#********************************************
' * Programmer Name : mcrider
' * Web Site    : http://www.geocities.com/ResearchTriangle/6311/
' * E-Mail          : waty.thierry@usa.net
' * Date            : 22/10/1999
' * Time            : 15:43
' *******************************************************
' * Comments: CopyFromGrid/PasteToGrid from clipboard
' *
' *
' ********************************************************
Public Sub CopyFromGrid(GridObject As Object, _
   Optional StartRow As Variant, Optional EndRow As Variant, _
   Optional StartCol As Variant, Optional EndCol As Variant)


Dim Row As Integer
Dim Col As Integer
Dim sRow As Integer
Dim sCol As Integer
Dim eRow As Integer
Dim eCol As Integer
Dim R1 As Integer
Dim R2 As Integer
Dim C1 As Integer
Dim C2 As Integer
Dim ClipString As String
Dim v As Variant
On Error Resume Next
v = GridObject.TextMatrix(0, 0)
If Err.Number > 0 Then Exit Sub
On Error GoTo 0
ClipString = "[GRIDCLIP]" + vbFormFeed
With GridObject
   sRow = .Row: If IsMissing(StartRow) = False Then _
      sRow = StartRow
   sCol = .Col: If IsMissing(StartCol) = False Then _
      sCol = StartCol
   eRow = .RowSel: If IsMissing(EndRow) = False Then _
      eRow = EndRow
   eCol = .ColSel: If IsMissing(EndCol) = False Then _
      eCol = EndCol
   If sCol > eCol Then
      C1 = eCol: C2 = sCol
   Else
      C1 = sCol: C2 = eCol
   End If
   If sRow > eRow Then
      R1 = eRow: R2 = sRow
   Else
      R1 = sRow: R2 = eRow
   End If
   For Row = R1 To R2
      For Col = C1 To C2
         ClipString = ClipString + .TextMatrix(Row, Col) _
            + vbVerticalTab
      Next Col
      ClipString = ClipString + vbFormFeed
   Next Row
   Clipboard.Clear
   Clipboard.SetText ClipString, vbCFText
End With

End Sub

Public Function PasteToGrid(GridObject As Object, _
   Optional StartRow As Variant, Optional StartCol As Variant) _
   As Boolean
   
'THIS FUNCTION WILL PASTE THE CLIPBOARD CONTENTS OF A
'CopyFromGrid CALL IF StartRow AND StartCol ARE NOT SPECIFIED,
'THE CURRENT GRID ROW/COL ARE USED
'THIS FUNCTION WILL RETURN TRUE IF SUCCESSFUL
Dim Row As Long
Dim Col As Long
Dim sRow As Long
Dim sCol As Long
Dim ClipString As String
Dim ClipLine As String
Dim Cindex As Long
Dim v As Variant

On Error Resume Next
v = GridObject.TextMatrix(0, 0)
If Err.Number > 0 Then Exit Function
PasteToGrid = False
ClipString = Clipboard.GetText
If Not (Left$(ClipString, 11) = "[GRIDCLIP]" + vbFormFeed) _
   Then Exit Function
ClipString = Mid$(ClipString, 12)
With GridObject
   sRow = .Row: If IsMissing(StartRow) = False _
     Then sRow = StartRow
   sCol = .Col: If IsMissing(StartCol) = False _
     Then sCol = StartCol
   Row = sRow
   Do While Not (ClipString = "")
      Cindex = InStr(1, ClipString, vbFormFeed)
      ClipLine = Left$(ClipString, Cindex - 1)
      ClipString = Mid$(ClipString, Cindex + 1)
      Col = sCol
      Do While Not (ClipLine = "")
         Cindex = InStr(1, ClipLine, vbVerticalTab)
         .TextMatrix(Row, Col) = Left$(ClipLine, Cindex - 1)
         If Not (Err = 0) Then Exit Function
         ClipLine = Mid$(ClipLine, Cindex + 1)
         Col = Col + 1
      Loop
      Row = Row + 1
   Loop
End With
PasteToGrid = True
   
End Function