Attribute VB_Name = "ModUtils"
' modUtils in Job Cost wks
' Date: 2017-04-21
'
'//=====10========20========30========40========50========60========70========80
Option Private Module
Option Explicit
'
'//=====10========20========30========40========50========60========70========80
Sub Clear_TextBox()
' Called by the sub ClearWetFrm or ClearAlmFrm
'
' Clear the text Box in the current sheet
'  after user has given the go ahead to set the form back to default values.
' For one text box:
'    ActiveSheet.OLEObjects("txtCommentsWet").Object.Value = ""
' For multiple text boxes on a sheet:
'    the following sub is in ModUtils.
' The Text box in the sheet must be of type TextBox.
'
Dim tbx As OLEObject
    For Each tbx In ActiveSheet.OLEObjects
        If TypeName(tbx.Object) = "TextBox" Then
            tbx.Object.Text = ""
        End If
    Next
End Sub
'
'//=====10========20========30========40========50========60========70========80
Sub btnArrangeAll()
'DELET ME arun
' Does a View>ArrangeAll so you can see the tabs of the sheets at bottom
'   Windows.Arrange arrangestyle:=xlVertical
'
' Move to First Sheet Cell A1
   Application.GoTo Sheet0.Range("A1"), True
' resize sheet to fit window
   Application.Windows.Arrange arrangestyle:=xlArrangeStyleVertical
'  ref: http://www.cpearson.com/excel/codemods.htm
End Sub
'
'//=====10========20========30========40========50========60========70========80
Sub btnCreateLinksToAll()
' Called by the button labeled: [Re-Index] on the TOC page
Dim sh As Worksheet
Dim cell As Range
    Sheets("0 TOC").Select

' resize sheet to fit window
' Turm off screen updating
' Turn off events and screen flickering.
With Application
    .Windows.Arrange arrangestyle:=xlArrangeStyleVertical
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

' Now run ..
MacroUnProtect
'     then run ...
arrangeALL
' and now ..
    Range("A2:B35").ClearContents
    Range("B9").Select
    
For Each sh In ActiveWorkbook.Worksheets
    If ActiveSheet.Name <> sh.Name Then
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
        ActiveCell.Offset(1, 0).Select
    End If
Next sh
    Range("B9:B34").Select
' Now reformat the selected range correctly
' hyperlinks cleaner
    With Selection.Font
        .Name = "Times New Roman"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ThemeColor = xlThemeColorHyperlink
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
' end of the reformat

    Range("A2").Select
    Range("A2") = "     Version: " & txtVersion & "." & txtSubVersion
    Range("A3").Select
    Range("A3") = "Last Mods: " & txtLastModDate
    Range("H73").Select
    Range("H73") = "Revision: " & txtRev
    Range("A4") = "You MUST first load the dBase file ..."
    Range("B5") = "[" & txtPartsFileName & "]"
    Range("D6") = "IMPORTANT!"
'
    Range("B8") = " Links"
    Range("C8") = " Action"
    Range("E8") = " By whom"
    Range("C36") = "Cheers: " & txtAuthor
    Range("A1").Select

MacroProtect
' Turn on screen updating
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
'
' =======================================================================
Sub MacroUnProtect()
    ActiveSheet.Unprotect
End Sub
'
' =======================================================================
Sub MacroProtect()
' see the ThisWorkbook Open Code where I use a similar protect
    ActiveSheet.Protect _
            Password:="", _
            Contents:=True, _
            DrawingObjects:=True, _
            Scenarios:=True, _
            AllowFiltering:=True, _
            AllowFormattingCells:=False, _
            AllowFormattingColumns:=False, _
            AllowFormattingRows:=False, _
            AllowSorting:=False
End Sub
'
' =======================================================================
Sub arrangeALL()
' Also see Sheet 0 code
'
' Move to First Sheet Cell A1
   Application.GoTo Sheet0.Range("A1"), True
' resize sheet to fit window
' Does a View>ArrangeAll so you can see the tabs of the sheets at bottom
   Application.Windows.Arrange arrangestyle:=xlArrangeStyleVertical
'  ref: http://www.cpearson.com/excel/codemods.htm
End Sub
'
' =======================================================================
Sub SelectAll_Click()
' single check-box that clears or checks all others
Dim CB As CheckBox
    For Each CB In ActiveSheet.CheckBoxes
        If CB.Name <> ActiveSheet.CheckBoxes("Check Box All").Name Then
        CB.Value = ActiveSheet.CheckBoxes("Check Box All").Value
        End If
    Next CB
End Sub
'
' =======================================================================
Sub Mixed_State()
Dim CB As CheckBox
    For Each CB In ActiveSheet.CheckBoxes
        If CB.Name <> ActiveSheet.CheckBoxes("Check Box All").Name And CB.Value <> ActiveSheet.CheckBoxes("Check Box All").Value And ActiveSheet.CheckBoxes("Check Box All").Value <> 2 Then
        ActiveSheet.CheckBoxes("Check Box All").Value = 2
        Exit For
        Else
        ActiveSheet.CheckBoxes("Check Box All").Value = CB.Value
        End If
    Next CB
End Sub
'
' =======================================================================
Sub IsWorkBookOpen()
''''''''''''''''''''''''''''''''''''''''''
'Written by www.ozgrid.com
' Test to see if a Workbook is open.
'   Might want to check the ThisWorkBook Code.
'   I added 2017-01-22 an AlreadyOpen Function
'   that loads the Parts List if needed.
' Arun
''''''''''''''''''''''''''''''''''''''''''
Dim wBook As Workbook
Dim wBName, wbFile
wBName = "The Parts List File "
wbFile = "01 Parts List WKS dBase.xlsm"
On Error Resume Next
Set wBook = Workbooks("01 Parts List WKS dBase.xlsm")

If wBook Is Nothing Then 'Not open
    MsgBox wBName & "--" & wbFile & "-- is MISSING", _
    vbCritical, "OzGrid.com"
        Set wBook = Nothing
        On Error GoTo 0
Else 'It is open
        MsgBox wBName & "--" & wbFile & "-- is OPEN", _
            vbInformation, "Aurian Systems"
            Set wBook = Nothing
            On Error GoTo 0
        End If
End Sub
'
'//=====10========20========30========40========50========60========70========80
'Sub SortALLSheets()
'  'sort sheets within a workbook in Excel 7 -- Bill Manville
'  'modified to sort all sheets instead of just worksheets
'    Dim iSheet As Long, iBefore As Long
'  For iSheet = 1 To ActiveWorkbook.Sheets.Count   '    Replace 2 with 1 to sort from first sheet
'    Sheets(iSheet).Visible = True
'    For iBefore = 1 To iSheet - 1
'      If UCase(Sheets(iBefore).Name) > UCase(Sheets(iSheet).Name) Then
'        ActiveWorkbook.Sheets(iSheet).Move Before:=ActiveWorkbook.Sheets(iBefore)
'        Exit For
'      End If
'    Next iBefore
'  Next iSheet
'End Sub
'
' ======================================================================= FUNCTIONS
Function GetFillColor(rng As Range) As Long
' http://excelribbon.tips.net/T010780_Colors_in_an_IF_Function.html
    GetFillColor = rng.Interior.ColorIndex
End Function
'
' =======================================================================
Function AlreadyOpen(sFname As String) As Boolean
    Dim wkb As Workbook
    On Error Resume Next
    Set wkb = Workbooks(sFname)
    AlreadyOpen = Not wkb Is Nothing
    Set wkb = Nothing
End Function
'