|
Creating reports in a Grid (MsFlexgrid) is often a good move. You get a well ordered layout and the option of providing column sorts and such for your users with very little extra coding. Given they are easy to use yet functional then you need a couple of additional utilities to complete things. One of these is a utility to copy all or a user selected portion of a grid onto the clipboard.
The routine can service any number of grids in any given application as the grid name is passed as an argument along with an index (value 0 = Copy and value 1 = copy All) reflecting the users requirements.
The routine supports “reverse selection” where the user has dragged the mouse “up left” instead of the more expected “down right”. Rows and columns that are not visible to the user are not copied - you may well use these for sorting data or to hold additional data about a row to support other processes. Values from merged cells are only copied once as this will most closely meet your users expectations. The grid is copied in a format that is best suited to pasting into a spreadsheet - the most common requirement.
The subroutine addresses a boolean variable LargeCopy as I like to keep system overheads low wherever possible. You can add a check on this value to your program (or window) termination routine similar to the following:
Public LargeCopy as Boolean
If LargeCopy Then
Msg = "A large quantity of data was copied onto the clip-board."
Msg = Msg & vbLf & "Do you wish to keep the data on the clip-board after"
Msg = Msg & vbLf & "closing this program?"
title = "Memory Overhead"
Retval = MsgBox(Msg, vbQuestion + vbYesNo, title)
If REtval = vbNo Then
Clipboard.Clear
End If
End If
Now the copy routine itself:
Public Sub DoGridCopy(GridToCopy As MSFlexGrid, Index As Integer)
Dim CopyString As String, CellString As String
Dim GridRLoop As Integer, GridCLoop As Integer, ColCount As Integer
Dim RowStart As Integer, RowEnd As Integer, RowCount As Integer
Dim ColStart As Integer, ColEnd As Integer, LastCol As Integer
Dim FirstRow As Boolean
On Error GoTo CopyErr
Screen.MousePointer = vbHourglass
Select Case Index
Case 0 'Copy Selected
RowStart = GridToCopy.RowSel
RowEnd = GridToCopy.Row
ColStart = GridToCopy.ColSel
ColEnd = GridToCopy.Col
If RowStart > RowEnd Then
GridRLoop = RowEnd
RowEnd = RowStart
RowStart = GridRLoop
End If
If ColStart > ColEnd Then
GridCLoop = ColEnd
ColEnd = ColStart
ColStart = GridCLoop
End If
Case Else 'Copy All
RowStart = 0
RowEnd = GridToCopy.Rows - 1
ColStart = 0
ColEnd = GridToCopy.Cols - 1
End Select
LastCol = ColEnd
For GridCLoop = ColEnd To ColStart Step -1
If GridToCopy.ColWidth(GridCLoop) > 1 Then
Exit For
Else
LastCol = LastCol - 1
End If
Next GridCLoop
FirstRow = True
For GridRLoop = RowStart To RowEnd
If GridToCopy.RowHeight(GridRLoop) > 1 Then
For GridCLoop = ColStart To LastCol
If GridToCopy.ColWidth(GridCLoop) > 1 Then
If FirstRow Then
ColCount = ColCount + 1
End If
CellString = GridToCopy.TextMatrix(GridRLoop, GridCLoop)
If GridToCopy.MergeRow(GridRLoop) And GridCLoop > ColStart Then
If CellString = GridToCopy.TextMatrix(GridRLoop, (GridCLoop - 1)) Then
'we will want to skip the content
CellString = ""
End If
End If
If GridToCopy.MergeCol(GridCLoop) And GridRLoop > RowStart Then
If CellString = GridToCopy.TextMatrix((GridRLoop - 1), GridCLoop) Then
CellString = ""
End If
End If
CopyString = CopyString & CellString
If GridCLoop = LastCol Then
If GridRLoop < RowEnd Then
CopyString = CopyString & vbLf
End If
Else
CopyString = CopyString & vbTab
End If
End If
Next GridCLoop
RowCount = RowCount + 1
FirstRow = False
End If
Next GridRLoop
Clipboard.Clear
Clipboard.SetText CopyString
Screen.MousePointer = vbDefault
If Len(CopyString) > 2000 Then
LargeCopy = True
MsgBox CStr(RowCount) & " Rows and " & CStr(ColCount) & " Columns", vbInformation + vbOKOnly, "Copy Complete"
Else
LargeCopy = False
End If
Exit Sub
CopyErr:
CopyString = ""
Select Case Err
Case 7, 44 'memory and string space problems
Msg = "Sorry the selected report lines exceed"
Msg = Msg & vbLf & "the available Windows memory."
Msg = Msg & vbLf & "Please copy the report in smaller selections."
title = "Windows Resource Problems"
Case Else
Msg = "Sorry, an error occured and the copy"
Msg = Msg & vbLf & "was not completed."
Msg = Msg & vbLf & "Error code = " & CStr(Err) & vbLf & Error$
title = "Copy Failed"
End Select
Screen.MousePointer = vbDefault
MsgBox Msg, vbExclamation, title
Exit Sub
End Sub
|
