C# Snippets
Address_ColumnLetter
Returns the column letter from a cell address containing a column and a row.source codeReturns the column letter from a cell address containing a column and a row.
Public Function Address_ColumnLetter(ByVal sCellAddress As String) As String
Dim sreturn As String
'maybe dollars maybe not
'maybe column is greater than 26
'remove the initial $ and the following $1
sreturn = Strings.Mid(sAddress, 2, Strings.Len(sAddress) - 3)
Address_ColumnLetter = sreturn
End Function
Public Sub Test_Addresses()
Dim srange As String
srange = Range("A1").Address
Debug.Print Address_ColumnLetter(srange)
End Sub
Cell_FormatNumber
Public Sub Cell_FormatNumber(ByVal sCellAddress As String, _
ByVal sNumberFormat As String)
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Try
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
objRange = CType(objWorksheet.Range(sCellAddress), Excel.Range)
objRange.NumberFormat = sNumberFormat
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("FormatNumber", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cell_OffsetFormat
private static void Cell_OffsetFormat(Excel.Range objCell,
int iRowOffset,
int iColumnOffset,
string sText,
bool bBold,
Excel.XlHAlign enHAlignment,
string sNumberFormat)
{
if (sNumberFormat.Length > 0)
{
objCell.get_Offset(iRowOffset, iColumnOffset).NumberFormat = sNumberFormat;
}
System.DateTime result;
if (System.DateTime.TryParse(sText, out result) == false)
{
// Note that C# requires you to retrieve and set
// the Value2 property of the Range, rather than
// the Value property, because the Value property
// is parameterized, making it unavailable to C# code:
objCell.get_Offset(iRowOffset, iColumnOffset).Value2 = sText;
}
else
{
objCell.get_Offset(iRowOffset, iColumnOffset).Value2 = result;
}
objCell.get_Offset(iRowOffset, iColumnOffset).Font.Bold = bBold;
objCell.get_Offset(iRowOffset, iColumnOffset).HorizontalAlignment = enHAlignment;
}
Cell_OffsetInsertRandomNumbers
private static void Cell_OffsetInsertRandomNumbers(Excel.Range objCell,
int iNoOfRows,
int iNoOfColumns,
double dbLowestValue,
double dbHighestValue,
int iNoOfDecimals,
bool bInsertFormula)
{
int irowcount;
int icolcount;
Excel.Range objCell2;
Random objRandom = new System.Random();
for (irowcount = 0; irowcount <= iNoOfRows; irowcount++)
{
for (icolcount = 0; icolcount <= iNoOfColumns; icolcount++)
{
objCell2 = objCell.get_Offset(irowcount, icolcount);
objCell2.set_Value(System.Reflection.Missing.Value,
Number_Random(dbLowestValue, dbHighestValue, iNoOfDecimals, objRandom));
//This line also works
//objCell.get_Offset(irowcount, icolcount).Value2 = Number_Random(dbLowestValue, dbHighestValue, iNoOfDecimals);
}
}
}
Cell_PositionReturn
Public Shared Sub Cell_PositionReturn(ByVal objActiveCell As Excel.Range, _
ByRef sngFromLeft As Single, _
ByRef sngFromTop As Single)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim scolumnchar As String
If objActiveCell.Column = 1 Then
sngFromLeft = 0
Else
scolumnchar = clsCol.Letter(objActiveCell.Column - 1)
sngFromLeft = clsCol.WidthToPoints("A", scolumnchar)
End If
If objActiveCell.Row = 1 Then
sngFromTop = 0
Else
sngFromTop = clsRow.HeightToPoints(1, objActiveCell.Row - 1)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("PositionReturn", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cell_SelectCell
Public Shared Sub Cell_SelectCell(ByVal ParamArray asCellAddresses() As String)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim saddress As String
Dim scombined As String
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
For Each saddress In asCellAddresses
scombined = scombined & saddress & ","
Next saddress
scombined = scombined.Substring(0, scombined.Length - 1)
objRange = CType(objWorksheet.Range(scombined), Excel.Range)
objRange.Select()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("SelectCell", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cell_TextToColumns
Public Shared Sub Cell_TextToColumns(ByVal sCellAddress As String, _
Optional ByVal bDisplayAlerts As Boolean = False, _
Optional ByVal sWshName As String = "")
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
If sWshName.Length = 0 Then
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
Else
objWorksheet = CType(gApplicationExcel.Worksheets(sWshName), Excel.Worksheet)
End If
objRange = CType(objWorksheet.Range(sCellAddress), Excel.Range)
gApplicationExcel.DisplayAlerts = bDisplayAlerts
objRange.TextToColumns(Destination:=objRange, _
DataType:=Excel.XlTextParsingType.xlDelimited, _
TextQualifier:=Excel.XlTextQualifier.xlTextQualifierDoubleQuote, _
ConsecutiveDelimiter:=False, _
TAB:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
TrailingMinusNumbers:=True)
gApplicationExcel.DisplayAlerts = True
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("TextToColumns", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cell_TypeReturn
Public Function Cell_TypeReturn(ByVal objRange As Excel.Range) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
If objRange.Value Is Nothing Then
TypeReturn = "Nothing"
Exit Function
End If
Select Case CType(objRange.Value, String)
Case "True" : TypeReturn = "TRUE"
Case "False" : TypeReturn = "FALSE"
Case "#DIV/0!" : TypeReturn = "#DIV/0!"
Case "#N/A" : TypeReturn = "#N/A"
Case "#NAME?" : TypeReturn = "#NAME?"
Case "#NULL!" : TypeReturn = "#NULL!"
Case "NUM!" : TypeReturn = "#NUM!"
Case "#REF!" : TypeReturn = "#REF!"
Case "#VALUE!" : TypeReturn = "#VALUE!"
Case Else : TypeReturn = CType(objRange.Value, String)
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("TypeReturn", msCLASSNAME, _
"determine the type of the contents in cell: '" & objRange.Address & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Function
Cell_ValueToDate
Public Shared Function Cell_ValueToDate(ByVal sCellAddress As String, _
ByVal sDateFormat As String) _
As System.DateTime
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim dtDateTime As System.DateTime
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim scellcontents As String
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
objRange = CType(objWorksheet.Range(sCellAddress), Excel.Range)
scellcontents = CType(objRange.Value, System.String)
If scellcontents Is Nothing Then
ValueToDate = DateTime.Now()
Exit Function
End If
Select Case sDateFormat
Case "dd.mm.yyyy"
If scellcontents.Length = 10 Then
dtDateTime = New DateTime(CType(scellcontents.Substring(6, 4), System.Int32), _
CType(scellcontents.Substring(3, 2), System.Int32), _
CType(scellcontents.Substring(0, 2), System.Int32))
ValueToDate = dtDateTime
Else
ValueToDate = DateTime.Now()
End If
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ValueToDate", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Function
Cell_ValueToString
Public Shared Function Cell_ValueToString(ByVal sCellAddress As String) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim scellcontents As String
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
objRange = CType(objWorksheet.Range(sCellAddress), Excel.Range)
ValueToString = CType(objRange.Value, System.String)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ValueToString", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Function
CellRef_GetColFirst
Public Function CellRef_GetColFirst(ByVal sCompleteReference As String, _
Optional ByVal bIncludeDollar As Boolean = False) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sreference As String
Dim icharpos As Integer
Dim bfound As Boolean
sreference = sCompleteReference
bfound = False
If bIncludeDollar = False Then 'remove any preceding dollar
If InStr(sreference, "$") = 1 Then
sreference = Right(sreference, Len(sreference) - 1)
icharpos = 0
End If
End If
Do While (bfound = False) And (icharpos <= Len(sCompleteReference))
icharpos = icharpos + 1
If IsNumeric(Mid(sreference, icharpos, 1)) = True Or _
((Mid(sreference, icharpos, 1) = "$") And _
(IsNumeric(Mid(sreference, icharpos + 1, 1)))) = True Then
bfound = True
End If
Loop
Return Left(sreference, icharpos - 1)
If icharpos = Len(sCompleteReference) Then
'maybe raise an error ??
'GoTo AnError
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_GetColFirst", "clsCellRef", _
"return the first column letter from the reference" & vbCrLf & _
vbCrLf & "'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
CellRef_GetColLast
Public Function CellRef_GetColLast(ByVal sCompleteReference As String, _
Optional ByVal bIncludeDollar As Boolean = False) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sreference As String
Dim icolon As Integer
sreference = sCompleteReference
icolon = InStr(sreference, ":")
sreference = Right(sreference, Len(sreference) - icolon)
Return CellRef_GetColFirst(sreference, bIncludeDollar)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_GetColLast", "clsCellRef", _
"return the last column letter from the reference" & vbCrLf & _
vbCrLf & "'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
CellRef_GetRowFirst
Public Shared Function CellRef_RowFirstGet(ByVal sCompleteReference As String, _
Optional ByVal bIncludeDollar As Boolean = False) _
As String
RowFirstGet = ""
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sreference As String
Dim icolon As System.Int32
Dim bfound As Boolean
Dim icharpos As System.Int32
sreference = sCompleteReference
bfound = False
If bIncludeDollar = False Then 'remove any preceding dollar
If Microsoft.VisualBasic.InStr(sreference, "$") = 1 Then
sreference = Microsoft.VisualBasic.Right(sreference, sreference.Length - 1)
icharpos = 0
End If
End If
Do While (bfound = False) And (icharpos <= sreference.Length)
icharpos = icharpos + 1
If Microsoft.VisualBasic.IsNumeric(Microsoft.VisualBasic.Mid(sreference, icharpos, 1)) = True Or _
((Microsoft.VisualBasic.Mid(sreference, icharpos, 1) = "$") And _
(Microsoft.VisualBasic.IsNumeric(Microsoft.VisualBasic.Mid(sreference, icharpos + 1, 1)))) = True Then
bfound = True
End If
Loop 'remove first column
sreference = Microsoft.VisualBasic.Right(sreference, sreference.Length - icharpos + 1)
If bIncludeDollar = False Then 'remove any preceding dollar
If Microsoft.VisualBasic.InStr(sreference, "$") = 1 Then _
sreference = Microsoft.VisualBasic.Right(sreference, sreference.Length - 1)
End If
icolon = Microsoft.VisualBasic.InStr(sreference, ":")
If icolon = 0 Then 'there is no range of cells
Return sreference
Else
Return Microsoft.VisualBasic.Left(sreference, icolon - 1)
End If
If (icharpos = sCompleteReference.Length) Then
'maybe raise an error
'GoTo AnError
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("CellRef_GetRowFirst", msCLASSNAME, _
"return the first row number from the reference" & gsCRLF & _
gsCRLF & "'" & sCompleteReference & "'", _
mobjCOMException, mobjException)
End If
End Try
End Function
CellRef_GetRowLast
Public Shared Function CellRef_GetRowLast(ByVal sCompleteReference As String, _
Optional ByVal bIncludeDollar As Boolean = False) _
As String
RowLastGet = ""
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sreference As String
Dim icolon As System.Int32
sreference = sCompleteReference
icolon = Microsoft.VisualBasic.InStr(sreference, ":")
sreference = Microsoft.VisualBasic.Right(sreference, sreference.Length - icolon)
Return clsCellRef.RowFirstGet(sreference, bIncludeDollar)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("CellRef_GetRowLast", msCLASSNAME, _
"return the last row number from the reference" & gsCRLF & _
gsCRLF & "'" & sCompleteReference & "'", _
mobjCOMException, mobjException)
End If
End Try
End Function
CellRef_HasFolderPath
Public Function CellRef_HasFolderPath(ByVal sCompleteReference As String) As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim icolon As Integer
Dim isquarebracketopen As Integer
icolon = InStr(sCompleteReference, ":")
isquarebracketopen = InStr(sCompleteReference, "[")
If (icolon > 0) And (icolon < isquarebracketopen) Then
CellRef_HasFolderPath = True
Else
CellRef_HasFolderPath = False
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_HasFolderPath", "clsCellRef", _
"determine if there is a folder path in the reference" & vbCrLf & _
"'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
CellRef_HasRange
Public Function CellRef_HasRange(ByVal sCompleteReference As String) As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim icolon As Integer
icolon = InStr(sCompleteReference, ":")
'cannot have colons in file names or in sheet names
If icolon <> 0 Then CellRef_HasRange = True
If icolon = 0 Then CellRef_HasRange = False
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_HasRange", "clsCellRef", _
"determine if the reference contains a range of cells or an individual cell" & _
vbCrLf & "'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
CellRef_HasWbkName
Public Function CellRef_HasWbkName(ByVal sCompleteReference As String) As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim isinglespeechmark As Integer
Dim isquarebracketopen As Integer
isinglespeechmark = InStr(sCompleteReference, "'")
isquarebracketopen = InStr(sCompleteReference, "[")
If isinglespeechmark = 1 And isquarebracketopen = 2 Then
CellRef_HasWbkName = True
Else
CellRef_HasWbkName = False
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_HasWbkName", "clsCellRef", _
"determine if there is a workbook component in the reference" & vbCrLf & _
"'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
CellRef_HasWshName
Public Function CellRef_HasWshName(ByVal sCompleteReference As String) As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim isinglespeechmark As Integer
Dim iexclamationmark As Integer
isinglespeechmark = InStr(sCompleteReference, "'")
iexclamationmark = InStr(sCompleteReference, "!")
If (isinglespeechmark <> 0) Or _
(iexclamationmark <> 0) Then
CellRef_HasWshName = True
Else
CellRef_HasWshName = False
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("CellRef_HasWshName", "clsCellRef", _
"determine if there is a worksheet component in the reference" & vbCrLf & _
"'" & sCompleteReference & "'", _
gobjCOMException, gobjException)
End If
End Try
End Function
Cells_Clear
Public Shared Sub Cells_Clear(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
objrange.Clear()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Clear", "clsCells", _
"clear the contents of the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_Copy
Public Shared Sub Cells_Copy(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
objrange.Copy()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Copy", "clsCells", _
"copy the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_CopyPaste
Public Shared Sub Cells_CopyPaste(ByVal lFromRowFirst As Long, _
ByVal sFromColFirst As String, _
Optional ByVal lFromRowLast As Long = 0, _
Optional ByVal sFromColLast As String = "", _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0, _
Optional ByVal sTopLeftCell As String = "")
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sFromColLast = "" Then sFromColLast = clsCol.Letter(clsCol.Number(sFromColFirst) + iNoOfCols)
If lFromRowLast = 0 Then lFromRowLast = lFromRowFirst + lNoOfRows
objrange = objworksheet.Range(sFromColFirst & lFromRowFirst & ":" & sFromColLast & lFromRowLast)
objrange.Copy()
objrange = objworksheet.Range(sTopLeftCell)
objrange.Select()
Call clszLateBindingExcel.SelectionPaste()
gApplicationExcel.CutCopyMode = CType(False, Excel.XlCutCopyMode)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("CopyPaste", "clsCells", _
"copy the range " & _
"'" & sFromColFirst & lFromRowFirst & ":" & sFromColLast & lFromRowLast & "'" & _
" and paste to the cell range '" & sTopLeftCell & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_Cut
Public Shared Sub Cells_Cut(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
objrange.Cut()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Cut", "clsCells", _
"cut the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_Delete
Public Shared Sub Cells_Delete(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0, _
Optional ByVal enShiftDirection As Excel.XlDeleteShiftDirection = _
Excel.XlDeleteShiftDirection.xlShiftUp)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
objrange.Delete(Shift:=enShiftDirection)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Delete", "clsCells", _
"delete the range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & _
"' moving the remaining cells '" & enShiftDirection.ToString & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_Format
Public Shared Sub Cells_Format(ByVal sFontName As String, _
ByVal sngFontSize As Integer, _
ByVal iFontColour As Integer, _
ByVal bBold As Boolean, _
ByVal bItalic As Boolean, _
ByVal bUnder As Boolean, _
ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
With objrange.Font
.Name = sFontName
.Size = sngFontSize
.ColorIndex = iFontColour
.Bold = bBold
.Italic = bItalic
If bUnder = True Then .Underline = Excel.XlUnderlineStyle.xlUnderlineStyleSingle
If bUnder = False Then .Underline = Excel.XlUnderlineStyle.xlUnderlineStyleNone
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Format", "clsCells", _
"format the cells in the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_FormatBorderAdd
Public Shared Sub Cells_FormatBorderAdd(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
With objrange
.Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlThin
.Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeBottom).Weight = Excel.XlBorderWeight.xlThin
.Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeLeft).Weight = Excel.XlBorderWeight.xlThin
.Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeRight).Weight = Excel.XlBorderWeight.xlThin
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("FormatBorderAdd", "clsCells", _
"add a border around the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_FormatBorderAddTopBottom
Public Shared Sub Cells_FormatBorderAddTopBottom(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
With objrange
.Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlThin
.Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
.Borders(Excel.XlBordersIndex.xlEdgeBottom).Weight = Excel.XlBorderWeight.xlThin
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("FormatBorderAddTopBottom", "clsCells", _
"add a border to the top and bottom of the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_FormatBordersClear
Public Shared Sub Cells_FormatBordersClear(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
Dim objborder As Excel.Border
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
With objrange
.Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlLineStyleNone
.Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlLineStyleNone
.Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlLineStyleNone
.Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlLineStyleNone
.Borders(Excel.XlBordersIndex.xlInsideHorizontal).LineStyle = Excel.XlLineStyle.xlLineStyleNone
.Borders(Excel.XlBordersIndex.xlInsideVertical).LineStyle = Excel.XlLineStyle.xlLineStyleNone
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
If lNoOfRows > 0 Then lRowLast = lRowFirst + lNoOfRows
Call clsError.Handle("FormatBordersClear", "clsCells", _
"clear all the borders from the cells in the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_FormatInterior
Public Shared Sub Cells_FormatInterior(ByVal iColorIndex As Integer, _
ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
With objrange.Interior
.ColorIndex = iColorIndex
'= Excel.XlColorIndex.xlColorIndexNone
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("FormatInterior", "clsCells", _
"format the interior of the cells in the " & _
"range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_Insert
Public Shared Sub Cells_Insert(ByVal sColFirst As String, _
ByVal lRowFirst As Long, _
Optional ByVal sColLast As String = "", _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0, _
Optional ByVal enShiftDirection As Excel.XlInsertShiftDirection = _
Excel.XlInsertShiftDirection.xlShiftDown)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows
objrange = objworksheet.Range(sColFirst & lRowFirst & ":" & sColLast & lRowLast)
objrange.Insert(Shift:=enShiftDirection)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("Insert", "clsCells", _
"insert the range '" & sColFirst & lRowFirst & ":" & sColLast & lRowLast & _
"' moving the existing cells '" & enShiftDirection.ToString & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_RecordMove
Public Shared Function Cells_RecordMove(ByRef sPositiveOrNegativeChange As String, _
ByVal vsbLineMove As System.Windows.Forms.VScrollBar, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
ByVal iRowNoActive As Integer, _
ByVal lNoOfRowsInSelection As Integer, _
ByVal lCurrentRowInSelection As Integer, _
ByVal iNextVisibleRow As Integer, _
ByVal iPreviousVisibleRow As Integer, _
Optional ByVal iColorIndex As Integer = 15) _
As Integer
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
If vsbLineMove.Value = 0 Then vsbLineMove.Value = vsbLineMove.Value + 1
If vsbLineMove.Value = 0 Then Exit Function
'make the dialog box modeless and select the cell in the relevant row
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
objRange = CType(objWorksheet.Range(sColFirst & iRowNoActive & ":" & sColLast & iRowNoActive), Excel.Range)
objRange.Interior.ColorIndex = Excel.XlColorIndex.xlColorIndexNone
sPositiveOrNegativeChange = ""
If (vsbLineMove.Value > lCurrentRowInSelection) Then
If (iRowNoActive) >= iRowFirst And _
(iRowNoActive + 1) <= iRowLast Then
If (iNextVisibleRow <= iRowLast) Then
iRowNoActive = iNextVisibleRow
End If
sPositiveOrNegativeChange = "Positive"
Else
vsbLineMove.Value = vsbLineMove.Value - 1
End If
Else
If (vsbLineMove.Value < lCurrentRowInSelection) Then
If (iRowNoActive - 1) >= iRowFirst And _
(iRowNoActive) <= iRowLast Then
If (iPreviousVisibleRow >= iRowFirst) Then
iRowNoActive = iPreviousVisibleRow
Else
vsbLineMove.Value = vsbLineMove.Value - 1
End If
sPositiveOrNegativeChange = "Negative"
Else
vsbLineMove.Value = vsbLineMove.Value + 1
End If
End If
End If
objRange = CType(objWorksheet.Range(sColFirst & iRowNoActive & ":" & sColLast & iRowNoActive), Excel.Range)
objRange.Interior.ColorIndex = iColorIndex
RecordMove = iRowNoActive
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("RecordMove", "clsCells", _
"", _
mobjCOMException, mobjException)
End If
End Try
End Function
Cells_RemoveDuplicatesInColumn
Public Shared Sub Cells_RemoveDuplicatesInColumn(ByVal sDuplicateCol As String, _
ByVal sColFirst As String, _
ByVal i64RowFirst As Int64, _
Optional ByVal sColLast As String = "", _
Optional ByVal i64RowLast As Int64 = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal i64NoOfRows As Int64 = 0, _
Optional ByVal bTopDuplicate As Boolean = True)
Dim objworksheet As Excel.Worksheet
Dim objrange1 As Excel.Range
Dim objrange2 As Excel.Range
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim i64rownumber As Int64
Dim i64columnnumber As Int64
Dim i64columnduplicate As Int64
Dim icolumnfirst As Integer
Dim icolumnlast As Integer
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If i64RowLast = 0 Then i64RowLast = i64RowFirst + i64NoOfRows
i64columnduplicate = clsCol.Number(sDuplicateCol)
icolumnfirst = clsCol.Number(sColFirst)
icolumnlast = clsCol.Number(sColLast)
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
For i64rownumber = i64RowLast To (i64RowFirst + 1)
objrange1 = CType(objworksheet.Range(sDuplicateCol & i64rownumber), Excel.Range)
objrange2 = CType(objworksheet.Range(sDuplicateCol & i64rownumber - 1), Excel.Range)
If CStr(objrange1.Value) = CStr(objrange2.Value) Then
If bTopDuplicate = True Then
clsCells.Delete(sColFirst, i64rownumber, sColLast, i64rownumber - 1, , , _
Excel.XlDeleteShiftDirection.xlShiftUp)
End If
If bTopDuplicate = False Then
clsCells.Delete(sColFirst, i64rownumber, sColLast, i64rownumber, , , _
Excel.XlDeleteShiftDirection.xlShiftUp)
End If
End If
Next i64rownumber
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("RemoveDuplicatesInColumn", "clsCells", _
"", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_ToArray
Public Shared Sub Cells_ToArray(ByVal sArrayname As String, _
ByRef asArrayName(,) As String, _
ByVal iColFirst As Integer, _
ByVal lRowFirst As Long, _
Optional ByVal iColLast As Integer = 0, _
Optional ByVal lRowLast As Long = 0, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal lNoOfRows As Long = 0, _
Optional ByVal sWshName As String = "")
'need a column to array for a 1-dimensional array
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objworksheet As Excel.Worksheet
Dim objrangestart As Excel.Range
Dim objrangefinish As Excel.Range
Dim objrange As Excel.Range
Dim icolumncounter As Integer
Dim lrowcounter As Long
If iColLast = 0 Then iColLast = iColFirst + iNoOfCols - 1
If lRowLast = 0 Then lRowLast = lRowFirst + lNoOfRows - 2
ReDim asArrayName(CType(lRowLast - lRowFirst, Integer), iColLast - iColFirst)
'Call MsgBox("Redim Array" & vbCrLf & _
' "First dimension : " & iColLast - iColFirst & vbCrLf & _
' "Second dimension : " & CType(lRowLast - lRowFirst, Integer))
If sWshName.Length = 0 Then
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
Else
objworksheet = CType(gApplicationExcel.Worksheets(sWshName), Excel.Worksheet)
End If
For icolumncounter = iColFirst To iColLast
For lrowcounter = lRowFirst To lRowLast
objrange = CType(objworksheet.Cells(lrowcounter, icolumncounter), Excel.Range)
asArrayName(CType(lrowcounter - lRowFirst, Integer), _
icolumncounter - iColFirst) = CStr(objrange.Value)
Next lrowcounter
Next icolumncounter
'objrangestart = CType(objworksheet.Cells(lRowFirst, iColFirst), _
' Microsoft.Office.Interop.Excel.Range)
'objrangefinish = CType(objworksheet.Cells(lRowLast, iColLast), _
' Microsoft.Office.Interop.Excel.Range)
'asArrayName = CType(objworksheet.Range(objrangestart, objrangefinish).Value, String(,))
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ToArray", "clsCells", _
"copy the range '" & iColFirst & lRowFirst & ":" & iColLast & lRowLast & _
"' into the array '" & sArrayname & "'", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_ToArrayLetters
Public Shared Sub Cells_ToArrayLetters(ByVal sArrayname As String, _
ByRef asArrayName(,) As String, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal iNoOfRows As Integer = 0)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim icolumnnumber As Integer
Dim irownumber As Integer
Dim icolumnfirst As Integer
Dim icolumnlast As Integer
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If iRowLast = 0 Then iRowLast = iRowFirst + iNoOfRows
icolumnfirst = clsCol.Number(sColFirst)
icolumnlast = clsCol.Number(sColLast)
ReDim asArrayName(icolumnlast - icolumnfirst, iRowLast - iRowFirst)
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
For icolumnnumber = icolumnfirst To icolumnlast
For irownumber = iRowFirst To iRowLast
objrange = CType(objworksheet.Cells(irownumber, icolumnnumber), _
Excel.Range)
asArrayName(icolumnnumber - icolumnfirst, irownumber - iRowFirst) = CStr(objrange.Value)
Next irownumber
Next icolumnnumber
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ToArrayLetters", "clsCells", _
"copy the range '" & sColFirst & iRowFirst & ":" & sColLast & iRowLast & _
"??", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_ToDataTable
Public Shared Sub Cells_ToDataTable(ByVal objDataSet As System.Data.DataSet, _
ByVal sTableName As String, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal iNoOfRows As Integer = 0)
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
Dim objDataRow As System.Data.DataRow
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim irownumber As Integer
Dim icolumnnumber As Integer
Dim icolumnfirst As Integer
Dim icolumnlast As Integer
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If iRowLast = 0 Then iRowLast = iRowFirst + iNoOfRows
icolumnfirst = clsCol.Number(sColFirst)
icolumnlast = clsCol.Number(sColLast)
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
For irownumber = iRowFirst To iRowLast
objDataRow = clsDataSet.mobjDataSet.Tables(sTableName).NewRow
For icolumnnumber = icolumnfirst To icolumnlast
objrange = CType(objworksheet.Cells(irownumber, icolumnnumber), Excel.Range)
objDataRow.Item(icolumnfirst - icolumnnumber) = CStr(objrange.Value)
Next icolumnnumber
objDataSet.Tables(sTableName).Rows.Add(objDataRow)
Next irownumber
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objworksheet = Nothing
objrange = Nothing
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ToDataTable", "clsCells", _
"transfer the range '" & sColFirst & iRowFirst & ":" & sColLast & iRowLast & _
"' to the datatable '" & sTableName & "'" & _
" in the dataset '" & objDataSet.ToString & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_ToListBox
Public Shared Sub Cells_ToListBox(ByVal objListBox As System.Windows.Forms.ListBox, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
Optional ByVal bIncludeTopBlank As Boolean = False, _
Optional ByVal iColumnNo As Integer = 0, _
Optional ByVal bUniqueItems As Boolean = False, _
Optional ByVal sWshName As String = "")
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim icolumnnumber As Integer
Dim irownumber As Integer
Dim swshname_before As String
Dim objworksheetbefore As Excel.Worksheet
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
If (sWshName.Length > 0) Then
objworksheetbefore = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
swshname_before = objworksheetbefore.Name
objworksheet = CType(gApplicationExcel.Worksheets(sWshName), Excel.Worksheet)
End If
If (sWshName.Length = 0) Then
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
End If
For icolumnnumber = clsCol.Number(sColFirst) To clsCol.Number(sColLast)
For irownumber = iRowFirst To iRowLast
objrange = CType(objworksheet.Cells(irownumber, icolumnnumber), Excel.Range)
objListBox.Items.Add(objrange.Value)
Next irownumber
Next icolumnnumber
If bIncludeTopBlank = True Then objListBox.Items.Add("")
If (sWshName.Length > 0) Then objworksheetbefore.Select()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ToListBox", "clsCells", _
"transfer the range '" & sColFirst & iRowFirst & ":" & sColLast & iRowLast & _
"' to the listbox '" & objListBox.ToString & "'", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Cells_ToListComboBox
Public Shared Sub Cells_ToListComboBox(ByVal lstBoxName As System.Windows.Forms.ListControl, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
lstBoxName.DataSource = sColFirst & iRowFirst & ":" & sColLast & iRowLast
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ToListComboBox", "clsWsh", _
"assign the source for the listbox '" & lstBoxName.ToString & "' to be the range " & _
"'" & sColFirst & iRowFirst & ":" & sColLast & iRowLast & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
Cells_ToListView
Public Shared Sub Cells_ToListView(ByVal objListView As System.Windows.Forms.ListView, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
Optional ByVal iNoOfCols As Integer = 0, _
Optional ByVal iNoOfRows As Integer = 0)
Dim objworksheet As Excel.Worksheet
Dim objrange As Excel.Range
Dim objlistviewitem As System.Windows.Forms.ListViewItem
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim irownumber As Integer
Dim icolumnnumber As Integer
Dim icolumnfirst As Integer
Dim icolumnlast As Integer
If sColLast = "" Then sColLast = clsCol.Letter(clsCol.Number(sColFirst) + iNoOfCols)
If iRowLast = 0 Then iRowLast = iRowFirst + iNoOfRows
icolumnfirst = clsCol.Number(sColFirst)
icolumnlast = clsCol.Number(sColLast)
objworksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
For irownumber = iRowFirst To iRowLast
objrange = CType(objworksheet.Cells(irownumber, icolumnnumber), Excel.Range)
objlistviewitem = objListView.Items.Add(CStr(objrange.Value))
For icolumnnumber = icolumnfirst To icolumnlast
objrange = CType(objworksheet.Cells(irownumber, icolumnnumber), Excel.Range)
objlistviewitem.SubItems.Add(CStr(objrange.Value))
Next icolumnnumber
Next irownumber
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ToListView", "clsCells", _
"copy the range '" & sColFirst & iRowFirst & ":" & sColLast & iRowLast & _
"to the listview '" & objListView.ToString & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Message_RangeNoNumericalData
Public Shared Sub Message_RangeNoNumericalData(ByVal sRangeAddress As String)
Call System.Windows.Forms.MessageBox.Show( _
"The range '" & sRangeAddress & "' does not include any numerical data.", _
gsDIALOG_PREFIX_EXCEL, _
Windows.Forms.MessageBoxButtons.OK, _
Windows.Forms.MessageBoxIcon.Information)
End Sub
Range_ColumnFirst
Public Shared Function Range_ColumnFirst(ByVal objRange As Excel.Range) _
As String
Try
If clsError.ErrorFlag() = True Then Exit Function
ColumnFirst = clsCol.Letter(objRange.Column)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ColumnFirst", "clsRange", _
"return the column letter for the first column in the range " & _
"'" & objRange.Address & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
Range_ColumnLast
Public Shared Function Range_ColumnLast(ByVal objRange As Excel.Range) _
As String
Try
If clsError.ErrorFlag() = True Then Exit Function
ColumnLast = clsCol.Letter(objRange.Column + objRange.Columns.Count - 1)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ColumnLast", "clsRange", _
"return the column letter for the last column in the range " & _
"'" & objRange.Address & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
Range_ConcatenateText
Public Shared Sub Range_ConcatenateText(ByVal objRange As Excel.Range, _
Optional ByVal sFromDirection As String = "Right", _
Optional ByVal bIncludeSpaces As Boolean = True, _
Optional ByVal bClearCellContents As Boolean = True)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objCellRange As Excel.Range
Dim objCellCurrent As Excel.Range
Dim icellcount As System.Int32
Dim scellcurrent As String = ""
Dim sconcat As String = ""
For icellcount = 1 To objRange.Count
objCellRange = CType(objRange.Cells(icellcount), Excel.Range)
sconcat = clsCell.ValueToString(objCellRange)
objCellCurrent = CType(objRange.Cells(icellcount), Excel.Range)
'offset 1 is from the right
objCellCurrent = objCellCurrent.Offset(0, 1)
scellcurrent = clsCell.ValueToString(objCellCurrent)
Do While (scellcurrent.Length > 0)
If bIncludeSpaces = True Then sconcat = sconcat & " "
sconcat = sconcat & scellcurrent
objCellCurrent = objCellCurrent.Offset(0, 1)
scellcurrent = clsCell.ValueToString(objCellCurrent)
Loop
objCellRange.Value = sconcat
Next icellcount
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("ConcatenateText", msCLASSNAME, _
"concatenate the text from the cells on the left in the range '" & objRange.Address & "'", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Range_HasNumericalData
Public Shared Function Range_HasNumericalData(ByVal objRange As Excel.Range, _
Optional ByVal bInformUser As Boolean = False) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim icellcount As Integer
Dim objcell As Excel.Range
Dim bnumeric As Boolean = False
For icellcount = 1 To objRange.Cells.Count
objcell = CType(objRange.Item(icellcount), Excel.Range)
If IsNumeric(objcell.Value) = True Then
bnumeric = True
Exit For
End If
Next icellcount
If bnumeric = False And bInformUser = True Then
Call clszMessagesExcel.RangeNoNumericalDataInformation(objRange.Address)
End If
HasNumericalData = bnumeric
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("HasNumericalData", "clsRange", _
"determine if the range '" & objRange.Address & "'" & _
" contains any numerical data.", _
mobjCOMException, mobjException)
End If
End Try
End Function
Range_OffSetValueToString
Public Shared Function Range_OffSetValueToString(ByVal objRange As Excel.Range, _
ByVal iOffsetRows As System.Int32, _
ByVal iOffsetColumns As System.Int32, _
Optional ByVal bReplaceSpaces As Boolean = False, _
Optional ByVal bLowerCase As Boolean = False) _
As String
OffSetValueToString = ""
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim objCell As Excel.Range
objCell = CType(objRange.Offset(iOffsetRows, iOffsetColumns), Excel.Range)
OffSetValueToString = CType(objCell.Value, System.String)
If bReplaceSpaces = True Then
OffSetValueToString = OffSetValueToString.Replace(" ", "")
End If
If bLowerCase = True Then
OffSetValueToString = OffSetValueToString.ToLower
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("OffSetValueToString", msCLASSNAME, _
"", _
mobjCOMException, mobjException)
End If
End Try
End Function
Range_PasteSpecial
Public Shared Sub Range_PasteSpecial(ByVal enPasteType As Excel.XlPasteType, _
ByVal enSpecialOperation As Excel.XlPasteSpecialOperation, _
Optional ByVal bTranspose As Boolean = False, _
Optional ByVal bSkipBlanks As Boolean = False)
Dim objRange As Excel.Range
Dim objWorksheet As Excel.Worksheet
Try
objRange = CType(gApplicationExcel.Selection, Excel.Range)
objRange.PasteSpecial(Paste:=enPasteType, _
Operation:=enSpecialOperation, _
SkipBlanks:=bSkipBlanks, _
Transpose:=bTranspose)
Catch objCOMException As System.Runtime.InteropServices.COMException
objWorksheet = CType(gApplicationExcel.ActiveSheet, Excel.Worksheet)
Call clszForceErrorsExcel.WorksheetPaste(objWorksheet)
Finally
objRange = Nothing
objWorksheet = Nothing
End Try
End Sub
Range_PasteSpecialText
Public Shared Function Range_PasteSpecialText() As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
PasteSpecialText = clszForceErrorsExcel.RangePasteSpecialText()
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("PasteSpecialText", msCLASSNAME, _
" ", _
mobjCOMException, mobjException)
End If
End Try
End Function
Range_RemoveSpaces
Public Shared Sub Range_RemoveSpaces(ByVal objRange As Excel.Range, _
Optional ByVal iNumberOfSpaces As System.Int32 = -1, _
Optional ByVal bAlwaysRemove As Boolean = False)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim objCellRange As Excel.Range
Dim icellcount As System.Int32
Dim scellcontents As String
For icellcount = 1 To objRange.Count
objCellRange = CType(objRange.Cells(icellcount), Excel.Range)
scellcontents = CType(objCellRange.Value, String)
If (Not scellcontents Is Nothing) Then
If (iNumberOfSpaces = -1) And (icellcount = 1) Then
iNumberOfSpaces = (scellcontents.Length - scellcontents.TrimStart.Length)
End If
If (scellcontents.Length > iNumberOfSpaces) And (iNumberOfSpaces > 1) Then
If bAlwaysRemove = True Then
objCellRange.Value = scellcontents.Substring(iNumberOfSpaces)
Else
If ((scellcontents.Length - scellcontents.TrimStart.Length) >= iNumberOfSpaces) Then
objCellRange.Value = scellcontents.Substring(iNumberOfSpaces)
Else
objCellRange.Value = scellcontents.TrimStart
End If
End If
End If
Else
'otherwise leave the cell unchanged
End If
Next icellcount
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As System.Exception
mobjException = objException
Finally
If gbDEBUG_ERRMSG_EXCEL = True Or _
((Not mobjCOMException Is Nothing) Or (Not mobjException Is Nothing)) Then
Call clsError.Handle("RemoveSpaces", msCLASSNAME, _
"remove the spaces on the LEFT from the range'" & objRange.Address & "'", _
mobjCOMException, mobjException)
End If
End Try
End Sub
Range_RowFirst
Public Shared Function Range_RowFirst(ByVal objRange As Excel.Range) _
As Integer
Try
If clsError.ErrorFlag() = True Then Exit Function
RowFirst = objRange.Row
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("RowFirst", "clsRange", _
"return the row number for the first row in the range " & _
"'" & objRange.Address & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
Range_RowLast
Public Shared Function Range_RowLast(ByVal objRange As Excel.Range) _
As Integer
Try
If clsError.ErrorFlag() = True Then Exit Function
RowLast = objRange.Row + objRange.Rows.Count - 1
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("RowLast", "clsRange", _
"return the row number for the last row in the range " & _
"'" & objRange.Address & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top