'
' Some notes about the RANGE object:
'   The .Value property (read/write) is the default property and returns a variant with the unformatted data in the cell.
'   There is also a .Text property (read/write) which applies formatting when returned.
'   There is also a .Value2 property which returns a variant but will not use the Currency and Data data types.
'   There is also a .Formula property (read/write) and .HasFormula (read only) property which are sometimes of use.
'   VarType() is the only known way to determine what the .Value (or .Value2) properties return.
'
' Some of the procedures below:
'   ExcelClearFormats       ' Clears format of all cells in the range, contents left alone.
'   ExcelClearContents      ' Clear contents of all cells in the range, leaves formatting alone.
'   ExcelFont               ' A general purpose procedure to change any of four things about a cell's font.
'   ExcelFontName           ' Change the font being used.
'   ExcelFontSize           ' Change font size, 1/2 point increments, must be at least 4 point or ignored.
'   ExcelFontStyle          ' Bold, italic, or both.
'   ExcelFontColor          ' Change font color to a set list of colors.
'   ExcelMergeCells         ' Merges a range of cells.
'   ExcelWrapText           ' Set/unset the wrap text flag for cells.
'   ExcelBackColor          ' The cell's back color.
'   ExcelAlign              ' Both horizontal and vertical text alignment are set.
'   ExcelBorders            ' This is a function with bits that can set any of the cell's borders (or range of cells).
'   ExcelDeleteRows         ' Deletes row (or rows) selected.
'   ExcelDeleteCols         ' Deletes column (or columns) selected.
'   ExcelInsertColToLeft    ' Insert column to left of selected column.
'   ExcelInsertRowAbove     ' Insert row above the selected row.
'   RangeStringFromNumbers  ' A function to return a string to be used in selecting a range.
'   ColNumberFromLetter     ' Returns number from alpha column designation.
'   ColLetterFromNumber     ' Returns column alpha designation from column number.
'   bWorksheetExists        ' Make sure worksheet is in workbook.
'   ExcelSave               ' Save an already saved workbook.
'   ExcelSaveAs             ' Save a workbook under a new name or that hasn't been previously been saved.
'
Option Explicit
'
Public Const msoConnectorStraight = 1
Public Const msoLineSolid = 1
Public Const msoLineDash = 4
'
Public Const xlExcel8 = 56&
Public Const xlOpenXmlWorkbookMacroEnabled = 52&
'
Public Const xlPicture = -4147&
Public Const xlPrinter = 2&
'
Public Const xlCalculationManual = -4135&
Public Const xlCalculationAutomatic = -4105&
'
Public Const xlCategory = 1&
Public Const xlValue = 2&
'
Public Const xlSolid = 1&
'
Public Const xlPasteValues = -4163
'
' Alignment constants.
Public Enum ExcelAlignHorz
    xlLeaveAloneH = 0&
    xlLeft = -4131&
    xlRight = -4152&
    xlCenterH = -4108&
End Enum
#If False Then ' Intellisense fix.
    Public xlLeaveAloneH, xlLeft, xlRight, xlCenterH
#End If
Public Enum ExcelAlignVert
    xlLeaveAloneV = 0&
    xlTop = -4160&
    xlBottom = -4107&
    xlCenterV = -4108&
End Enum
#If False Then ' Intellisense fix.
    Public xlLeaveAloneV, xlTop, xlBottom, xlCenterV
#End If
'
' Line constants.
Public Enum ExcelLineStyle
    xlContinuous = 1&   ' Not dashed.
    xlNone = -4142&     ' No line.
    xlDash = -4115&
    xlDot = -4118&
    xlDouble = -4119&
End Enum
#If False Then ' Intellisense fix.
    Public xlContinuous, xlNone, xlDash, xlDot, xlDouble
#End If
'
Public Enum ExcelLineWeight
    xlHairline = 1&     ' Almost fuzzy line.
    xlThin = 2&         ' The DEFAULT Excel line.
    xlMedium = -4138&   ' Slightly thicker.
    xlThick = 4&        ' VERY thick, seldom used.
End Enum
#If False Then ' Intellisense fix.
    Public xlHairline, xlThin, xlMedium, xlThick
#End If
'
Public Enum ExcelBorders
    xlEdgeLeft = 7&
    xlEdgeTop = 8&
    xlEdgeBottom = 9&
    xlEdgeRight = 10&
    xlInsideVertical = 11&
    xlInsideHorizontal = 12&
End Enum
#If False Then ' Intellisense fix.
    Public xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal
#End If
'
Public Enum ExcelBorderBits ' This is not Excel standard but makes specifying borders easier.
    xlLeftBorder = 1&
    xlTopBorder = 2&
    xlBottomBorder = 4&
    xlRightBorder = 8&
    xlInsideVertBorder = 16&
    xlInsideHorzBorder = 32&
End Enum
#If False Then ' Intellisense fix.
    Public xlLeftBorder, xlTopBorder, xlBottomBorder, xlRightBorder, xlInsideVertBorder, xlInsideHorzBorder
#End If
'
Public Enum ExcelColors ' Used with ColorIndex.
    xlAutomatic = -4105&    ' This is default (black).
    xlBlack = 1&
    xlLightGray = 15&
    xlMidGray = 48&
    xlWhite = 2&
    xlRed = 3&
    xlGreen = 4&
    xlBlue = 5&
    xlCyan = 8&
    xlYellow = 6&
    xlMagenta = 7&
    xlCyanDark = 14&
    xlYellowDark = 12&
    xlMagentaDark = 13&
End Enum
#If False Then ' Intellisense fix.
    Public xlAutomatic, xlBlack, xlLightGray, xlMidGray, xlWhite, xlRed, xlGreen, xlBlue, xlCyan, xlYellow, xlMagenta, xlCyanDark, xlYellowDark, xlMagentaDark
#End If
'
Public Enum WrapText
    xlWrapLeaveAlone = 9&
    xlWrapYes = -1&
    xlWrapNo = 0&
End Enum
#If False Then ' Intellisense fix.
    Public xlWrapLeaveAlone, xlWrapYes, xlWrapNo
#End If
'
Public Enum ExcelFontStyle
    xlStyleLeaveAlone = 0&
    xlRegular = 1&
    xlBoldItalic = 2&
    xlBold = 3&
    xlItalic = 4&
End Enum
#If False Then ' Intellisense fix.
    Public xlStyleLeaveAlone, xlRegular, xlBoldItalic, xlBold, xlItalic
#End If
'
Public Enum ExcelFontName
    xlFontLeaveAlone = 0&
    xlArial = 1&            ' This is the Excel default.
    xlTimes = 2&
    xlMsSanSerif = 3&
    xlSmallFonts = 4&
End Enum
#If False Then ' Intellisense fix.
    Public xlFontLeaveAlone, xlArial, xlTimes, xlMsSanSerif, xlSmallFonts
#End If
'
Public Enum ExcelDirection
    xlDown = -4121&
    xlUp = -4162&
    xlToLeft = -4159&
    xlToRight = -4161&
End Enum
#If False Then ' Intellisense fix.
    Public xlDown, xlUp, xlToLeft, xlToRight
#End If
'

Public Function ExcelIsOpen() As Boolean
    If hWndFromMidTitle("Microsoft Excel") Then
        ExcelIsOpen = True
        Exit Function
    End If
    If hWndFromMidTitle("- Excel") Then
        ExcelIsOpen = True
        Exit Function
    End If
End Function

Public Function ExcelApp() As Object
    ' This provides late binding of Microsoft Excel so that
    ' the version doesn't need to be known before binding.
    '
    ' Be SURE to execute a obj.Quit to remove the copy of Excel from memory.
    Dim obj As Object
    Dim Bad As Boolean
    '
    On Error Resume Next
        '
        Err.Clear
        Set obj = CreateObject("Excel.Application.11")
        '
        If Err <> 0 Then
            obj.Quit
            Set obj = Nothing
            Err.Clear
            Set obj = CreateObject("Excel.Application.10")
        End If
        '
        If Err <> 0 Then
            obj.Quit
            Set obj = Nothing
            Err.Clear
            Set obj = CreateObject("Excel.Application")
        End If
        '
        Select Case True
        Case Err <> 0
            Bad = True
        Case val(obj.Version) < 10
            Bad = True
        End Select
        '
        If Bad Then
            obj.Quit
            Set obj = Nothing
            MsgBox "Error.  Microsoft Excel was not found on this computer.  Microsoft Excel XP (aka 2002 or v10) or later must be installed on this computer for this program to execute this feature.  This program will now be terminated.", vbCritical, "Error."
            End
        End If
        '
        Set ExcelApp = obj
    On Error GoTo 0
End Function

Public Sub ExcelClearFormats(rng As Object)
    ' Clears all formatting.
    rng.ClearFormats
End Sub

Public Sub ExcelClearContents(rng As Object)
    ' Leaves all formatting intact.
    rng.ClearContents
End Sub

Public Sub ExcelFont(rng As Object, Optional FontName As ExcelFontName = xlArial, _
                                    Optional Size As Single = 10!, _
                                    Optional Style As ExcelFontStyle = xlRegular, _
                                    Optional ColorIndex As ExcelColors = xlAutomatic, _
                                    Optional RgbColor As Long = -1)
    ' If RgbColor is specified, ColorIndex is ignored.
    ExcelFontName rng, FontName
    ExcelFontSize rng, Size
    ExcelFontStyle rng, Style
    ExcelFontColor rng, ColorIndex, RgbColor
End Sub

Public Sub ExcelFontName(rng As Object, Optional FontName As ExcelFontName = xlArial)
    Select Case FontName
    Case xlArial
        rng.Font.Name = "Arial"
    Case xlTimes
        rng.Font.Name = "Times New Roman"
    Case xlMsSanSerif
        rng.Font.Name = "MS Sans Serif"
    Case xlSmallFonts
        rng.Font.Name = "Small Fonts"
    Case Else ' Leave alone.
    End Select
End Sub

Public Sub ExcelFontSize(rng As Object, Optional Size As Single = 10!)
    ' No font sizes smaller than 4 allowed.  Ignored if smaller.
    ' Half points are allowed.
    If Size >= 4! Then rng.Font.Size = Size
End Sub

Public Sub ExcelFontStyle(rng As Object, Optional Style As ExcelFontStyle = xlRegular)
    Select Case Style
    Case xlBoldItalic
        rng.Font.FontStyle = "Bold Italic"
    Case xlBold
        rng.Font.FontStyle = "Bold"
    Case xlItalic
        rng.Font.FontStyle = "Italic"
    Case xlRegular
        rng.Font.FontStyle = "Regular"
    Case Else ' Leave alone.
    End Select
End Sub

Public Sub ExcelFontColor(rng As Object, Optional ColorIndex As ExcelColors = xlAutomatic, _
                                         Optional RgbColor As Long = -1)
    ' If RgbColor is specified, ColorIndex is ignored.
    If RgbColor <> -1 Then
        rng.Font.color = RgbColor
    Else
        rng.Font.ColorIndex = ColorIndex
    End If
End Sub

Public Sub ExcelMergeCells(rng As Object, Optional Wrap As WrapText = xlWrapLeaveAlone, _
                                          Optional Horizontal As ExcelAlignHorz = xlLeaveAloneH, _
                                          Optional Vertical As ExcelAlignVert = xlLeaveAloneV)
    rng.MergeCells = False ' Excel does this and I think it prevents some errors.
    rng.Merge
    If Wrap <> xlWrapLeaveAlone Then rng.WrapText = Wrap
    If Horizontal <> xlLeaveAloneH Then rng.HorizontalAlignment = Horizontal
    If Vertical <> xlLeaveAloneV Then rng.verticalalignment = Vertical
End Sub

Public Sub ExcelWrapText(rng As Object, Wrap As WrapText)
    If Wrap <> xlWrapLeaveAlone Then rng.WrapText = Wrap
End Sub

Public Sub ExcelBackColor(rng As Object, Optional ColorIndex As ExcelColors = xlAutomatic, _
                                         Optional RgbColor As Long = -1)
    ' If RgbColor is specified, ColorIndex is ignored.
    If RgbColor <> -1 Then
        rng.Interior.color = RgbColor
    Else
        rng.Interior.ColorIndex = ColorIndex
    End If
End Sub

Public Sub ExcelAlign(rng As Object, Optional Horizontal As ExcelAlignHorz = xlLeaveAloneH, _
                                     Optional Vertical As ExcelAlignVert = xlLeaveAloneV)
    If Horizontal <> xlLeaveAloneH Then rng.HorizontalAlignment = Horizontal
    If Vertical <> xlLeaveAloneV Then rng.verticalalignment = Vertical
End Sub

Public Sub ExcelBorders(rng As Object, Borders As ExcelBorderBits, _
                                       Optional Style As ExcelLineStyle = xlNone, _
                                       Optional Weight As ExcelLineWeight = xlThin, _
                                       Optional ColorIndex As ExcelColors = xlAutomatic, _
                                       Optional RgbColor As Long = -1)
    ' This only affects the specified borders and leaves all others alone.
    ' To erase borders set ExcelLineStyle = xlNone.
    ' The most standard LineStyle is xlContinuous.
    ' If RgbColor is specified, ColorIndex is ignored.
    If Borders And xlLeftBorder Then
        rng.Borders(xlEdgeLeft).LineStyle = Style
        rng.Borders(xlEdgeLeft).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlEdgeLeft).color = RgbColor
        Else
            rng.Borders(xlEdgeLeft).ColorIndex = ColorIndex
        End If
    End If
    If Borders And xlTopBorder Then
        rng.Borders(xlEdgeTop).LineStyle = Style
        rng.Borders(xlEdgeTop).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlEdgeTop).color = RgbColor
        Else
            rng.Borders(xlEdgeTop).ColorIndex = ColorIndex
        End If
    End If
    If Borders And xlBottomBorder Then
        rng.Borders(xlEdgeBottom).LineStyle = Style
        rng.Borders(xlEdgeBottom).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlEdgeBottom).color = RgbColor
        Else
            rng.Borders(xlEdgeBottom).ColorIndex = ColorIndex
        End If
    End If
    If Borders And xlRightBorder Then
        rng.Borders(xlEdgeRight).LineStyle = Style
        rng.Borders(xlEdgeRight).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlEdgeRight).color = RgbColor
        Else
            rng.Borders(xlEdgeRight).ColorIndex = ColorIndex
        End If
    End If
    If Borders And xlInsideVertBorder Then
        rng.Borders(xlInsideVertical).LineStyle = Style
        rng.Borders(xlInsideVertical).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlInsideVertical).color = RgbColor
        Else
            rng.Borders(xlInsideVertical).ColorIndex = ColorIndex
        End If
    End If
    If Borders And xlInsideHorzBorder Then
        rng.Borders(xlInsideHorzBorder).LineStyle = Style
        rng.Borders(xlInsideHorzBorder).Weight = Weight
        If RgbColor <> -1 Then
            rng.Borders(xlInsideHorzBorder).color = RgbColor
        Else
            rng.Borders(xlInsideHorzBorder).ColorIndex = ColorIndex
        End If
    End If
End Sub

Public Sub ExcelDeleteRows(rng As Object)
    ' A single cell, a range of cells, or the entire row can be selected, and this will work.
    ' If more than one row is selected, they will all be deleted.
    rng.EntireRow.DELETE
End Sub

Public Sub ExcelDeleteCols(rng As Object)
    ' A single cell, a range of cells, or the entire column can be selected, and this will work.
    ' If more than one column is selected, they will all be deleted.
    rng.EntireColumn.DELETE
End Sub

Public Sub ExcelInsertColToLeft(rng As Object)
    ' A single cell, a range of cells, or the entire row can be selected, and this will work.
    rng.EntireColumn.Insert
End Sub

Public Sub ExcelInsertRowAbove(rng As Object)
    ' A single cell, a range of cells, or the entire row can be selected, and this will work.
    rng.EntireRow.Insert
End Sub

Public Function RangeStringFromNumbers(iRow1 As Long, iCol1 As Long, _
                                       iRow2 As Long, iCol2 As Long) As String
    ' The Range object actually has two syntaxes:
    '   1)   .Range(Cells(1, 1), (Cells(5, 5)).someproperty = ??
    '   2)   .Range("A1:E5).someproperty = ""
    ' And both of the above are equivalent.  However, the second syntax is more typical.
    ' The second syntax above is what this function builds a string for.
    '
    If (iRow1 = iRow2) And (iCol1 = iCol2) Then
        RangeStringFromNumbers = ColLetterFromNumber(iCol1) & Format$(iRow1)
    Else
        If iRow1 > iRow2 Then lSwap iRow1, iRow2
        If iCol1 > iCol2 Then lSwap iCol1, iCol2
        RangeStringFromNumbers = ColLetterFromNumber(iCol1) & Format$(iRow1) & ":" & ColLetterFromNumber(iCol2) & Format$(iRow2)
    End If
End Function

Public Function ColNumberFromLetter(sLetter As String) As Long
    Select Case Len(sLetter)
    Case 1
        ColNumberFromLetter = Asc(UCase$(sLetter)) - 64
    Case 2
        ColNumberFromLetter = ((Asc(UCase$(Left$(sLetter, 1))) - 64) * 26) + Asc(UCase$(Right$(sLetter, 1))) - 64
    End Select
End Function

Public Function ColLetterFromNumber(iNumber As Long) As String
    If iNumber > 26 * 26 Then Exit Function
    If iNumber <= 26 Then
        ColLetterFromNumber = Chr$(iNumber + 64)
    Else
        ColLetterFromNumber = Chr$((iNumber - 1) \ 26 + 64) & Chr$(((iNumber - 1) Mod 26) + 65)
    End If
End Function

Public Sub CopyRawFormulas(rng As Object)
    Dim r As Long
    Dim c As Long
    Dim sFormulas As String
    Dim s As String
    '
    Clipboard.Clear
    If TypeName(rng) <> "Range" Then Exit Sub
    If rng.Areas.Count <> 1 Then Exit Sub
    '
    For r = 1 To rng.Rows.Count
        For c = 1 To rng.Columns.Count
            s = vbNullString
            ' Figure out cell raw value.
            Select Case True
            Case IsEmpty(val(rng(r, c).Value))
            Case IsNull(val(rng(r, c).Value))
            Case IsMissing(val(rng(r, c).Value))
            Case Else ' It's got something in it.
                s = (rng(r, c).Formula)
            End Select
            ' Build matrix for clipboard.
            Select Case True
            Case r = 1 And c = 1:   sFormulas = s
            Case c = 1:             sFormulas = sFormulas & vbCrLf & s
            Case c > 1:             sFormulas = sFormulas & vbTab & s
            End Select
        Next c
    Next r
    ' Put raw values (from matrix) in clipboard.
    Clipboard.SetText sFormulas
End Sub

Public Function bWorksheetExists(wbk As Object, sSheetName As String) As Boolean
    ' The workbook must already be open before making this call.
    ' This is case sensitive.
    Dim i As Long
    '
    For i = 1 To wbk.Worksheets.Count
        If wbk.Worksheets(i).Name = sSheetName Then
            bWorksheetExists = True
            Exit Function
        End If
    Next i
    ' If we fall out, we didn't find it.
End Function

Public Sub ExcelSave(wbk As Object, Optional bForceOldFormat As Boolean = True)
    If bForceOldFormat Then
        If Int(wbk.Application.Version) > 11 Then ' It's Office 2007 or greater.
            wbk.CheckCompatibility = False
            wbk.Save
        Else
            wbk.Save
        End If
    Else
        wbk.Save
    End If
End Sub

Public Sub ExcelSaveAs(wbk As Object, sFileSpec As String, Optional bForceOldFormat As Boolean = True)
    If bForceOldFormat Then
        If Int(wbk.Application.Version) > 11 Then ' It's Office 2007 or greater.
            wbk.CheckCompatibility = False
            wbk.SaveAs sFileSpec, xlExcel8
        Else
            wbk.SaveAs sFileSpec
        End If
    Else
        If UCase$(Right$(sFileSpec, 4)) = "XLSM" Then
            wbk.SaveAs sFileSpec, xlOpenXmlWorkbookMacroEnabled
        Else
            wbk.SaveAs sFileSpec
        End If
    End If
End Sub