Hi -
I've posted this a few times, but so far, no one has cracked this. I have a large workbook (I'm actually not going to say how many worksheets but lets leave it at 3 digits). Its a cool application, works well except for one thing, at least that I know of. When I open it, it runs the workbook_open code and sometimes the Excel entry in status bar just blinks. I can click around a bit, i.e. I can open Visual Basic, open modules, select text but I can't copy it. Nor can I use the worksheets. It does show a macro as running but I try Ctrl-Break, Ctrl-C and lots of other stuff to no avail.
My "solution" is to copy the workbook to a non-trusted location and open it so the macros don't run. Then, I click to enable this content and it runs and all is good. Other times, I open the workbook and the macros run and then it works fine. I have yet to find a pattern.
I've been asked in the past to post the code, so, here goes....
I suspect there may subroutines I've not includded but if you've read this and want more, let me know.
I've posted this a few times, but so far, no one has cracked this. I have a large workbook (I'm actually not going to say how many worksheets but lets leave it at 3 digits). Its a cool application, works well except for one thing, at least that I know of. When I open it, it runs the workbook_open code and sometimes the Excel entry in status bar just blinks. I can click around a bit, i.e. I can open Visual Basic, open modules, select text but I can't copy it. Nor can I use the worksheets. It does show a macro as running but I try Ctrl-Break, Ctrl-C and lots of other stuff to no avail.
My "solution" is to copy the workbook to a non-trusted location and open it so the macros don't run. Then, I click to enable this content and it runs and all is good. Other times, I open the workbook and the macros run and then it works fine. I have yet to find a pattern.
I've been asked in the past to post the code, so, here goes....
Code:
Private Sub Workbook_Open()
On Error GoTo ErrHandler1:
Dim ErrorTrapped As String
Dim MSEnvironmentVariable As String
Dim SizeOfHelpFile As Long
Dim svThisVersionStr As String
Dim svMostCurrentVersionStr As String
Dim svThisVersion As Long
Dim svMostCurrentVersion As Long
wsAbout.Select ' This worksheet is selected first so that the release notes section is forced to come up when the user
' navigates away from this page. Couldn't call help directly from this subroutine as it went into an
' infinite loop.
ThisWorkbook.SheetPushedOntoStack = "wsAbout"
pvDebugModeOn = False
If pvDebugModeOn Then
svStyle = vbOKOnly
svErrorNo = 0
svTitle = "MONEYSCIENCE Error Message # " & svErrorNo
svErrorMessage = "This is a debug message and should not have displayed." & vbNewLine & vbNewLine & _
"*** You can proceed and ignore this. ***" & vbNewLine & _
"Let support know via the help topic Obtaining support" & vbNewLine & vbNewLine
subDisplayError svTitle, svErrorMessage, svStyle, True, svErrorNo, False
End If
'
' Check the setup of wsPrintAreaConfiguration for worksheet definitions
'
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
subErrorCheckWorksheetListing
'
' Make sure Workbook applications are set correctly.
'
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
ActivateSheetValveControlProcessing = False
Application.MoveAfterReturnDirection = xlToRight
'
' Global Variables
'
SizeOfHelpFile = 351989
pvPasswordForProtection = "Money"
SupportContactName = "Bill Brunt"
gblvarSupportContactEmail = "[EMAIL="billbrunt@usa.net"]billbrunt@usa.net[/EMAIL]"
SupportContactPhone = "201-663-1770"
'
'
'
ErrorTrapped = "No"
MSEnvironmentVariable = Environ("MS")
'
' Set a default worksheet to go back to if there are errors in wsLifeInsIllustratorSimulator
'
If ActiveSheet.Name <> "Life Ins Illustrator Simulator" Then
ThisWorkbook.SheetPushedOntoStack = ActiveSheet.Name
Else
ThisWorkbook.SheetPushedOntoStack = wsFDPXLIllustration1.Name
End If
'
' See if the environment variable %MS% exists or is empty.
'
If MSEnvironmentVariable = "" Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #10"
ErrorMessage = "The environment variable %MS% is NULL and not set." & vbNewLine & _
"Some features such as help and automatically loading" & vbNewLine & _
"FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
"" & vbNewLine & _
"To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
"MONEYSCIENCE LifeProfiler is installed and then restart Excel." & vbNewLine & _
vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
'
' Check to see if the environment variable %MS% is a valid path or file.
'
If GetAttr(MSEnvironmentVariable) <> 16 Then
End If
'
' Check that the environment variable %MS% is set to a valid path assuming the environment variable
' points to a file or directory which exists.
'
If ErrorTrapped = "No" Then
If GetAttr(MSEnvironmentVariable) And vbDirectory <> 16 Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #10"
ErrorMessage = "The environment variable %MS% is set to something other than a valid directory." & vbNewLine & _
"Some features such as help and automatically loading" & vbNewLine & _
"FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
"" & vbNewLine & _
"The environment variable %MS% is set to: " & MSEnvironmentVariable & vbNewLine & _
"" & vbNewLine & _
"To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
"MONEYSCIENCE LifeProfiler is installed and then restart Excel." & vbNewLine & _
"Currently, it is pointing to something other than a directory." & vbNewLine & _
vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
End If
'
' Ensure that the workbook running is the one in the directory contained in the environment variable %MS%
'
If ErrorTrapped = "No" Then
If ActiveWorkbook.Path & "\" & ActiveWorkbook.Name <> MSEnvironmentVariable & "\" & ActiveWorkbook.Name Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #12"
ErrorMessage = "The %MS% environment is set to a location containing a workbook of this name but you're not running" & vbNewLine & _
"the workbook in %MS%." & vbNewLine & vbNewLine & _
"The location you're running from is: " & ActiveWorkbook.Path & vbNewLine & _
"The location of %MS% is: " & Environ("MS") & vbNewLine & vbNewLine & _
"To fix this, either change the value of %MS% to this location or move this workbook to" & vbNewLine & _
"the directory specified by the environment variable %MS%." & vbNewLine & _
vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
End If
On Error GoTo ErrHandler2:
If FileLen(Environ("MS") + "\helpfiles\MoneyScience.chm") <> SizeOfHelpFile Then
If ErrorTrapped <> "Yes" Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #16"
ErrorMessage = "You don't have the most recent help file loaded in the correct location." & vbNewLine & _
"The helpfile " & Environ("MS") & "\helpfiles\MoneyScience.chm" & vbNewLine & _
"is " & Format(FileLen(Environ("MS") + "\helpfiles\MoneyScience.chm"), "#,##0") & " bytes in size " & _
"and should be " & Format(SizeOfHelpFile, "#,##0") & " bytes in size." & vbNewLine & _
vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
End If
'' Don't uncomment the next 3 lines as the dynamic ribbon control interferes and it is an endless loop.
'' If wsVariables.Range("Start_Help_When_Starting_Software").Value = "Yes" Then
'' CallsToHelp 13
'' End If
'
' Check the version number of this workbook against the most recent version out on the web and
' report to the user how this version compares to most recent web version.
' If the most recent web version value is different than what is in the range "MostCurrentVersion"
' then update the range MostCurrentVersion with the value from the web.
'
svThisVersionStr = wsAbout.Range("This_Version")
subGetCurrentVersionFromTheWeb
svThisVersion = Mid(svThisVersionStr, 1, 1) * 1000000 + _
Mid(svThisVersionStr, 3, 1) * 100000 + _
Mid(svThisVersionStr, 5, 1) * 10000 + _
Mid(svThisVersionStr, 7, 4)
svMostCurrentVersion = Mid(pvLifeProfilerVersion, 1, 1) * 1000000 + _
Mid(pvLifeProfilerVersion, 3, 1) * 100000 + _
Mid(pvLifeProfilerVersion, 5, 1) * 10000 + _
Mid(pvLifeProfilerVersion, 7, 4)
If svThisVersion < svMostCurrentVersion Then
MsgBox ("There is a newer version available on the web" & vbNewLine & _
"See the help topic Getting the Most Recent Version" & vbNewLine & _
"for more details on how to do.")
End If
If svThisVersion > svMostCurrentVersion Then
MsgBox ("You are running a version which is higher than the" & vbNewLine & _
"currently released version. Please notify support." & vbNewLine & vbNewLine & _
"Please see the help topic " & """" & "Obtaining Support" & """")
End If
If RTrim(pvLifeProfilerVersion) <> RTrim(Range("MostCurrentVersion").Value) Then
If wsAbout.Range("rnDeveloperOrUserMode").Value = "User" Then
wsAbout.Unprotect "Money"
Range("MostCurrentVersion").Value = pvLifeProfilerVersion
wsAbout.Protect "Money"
End If
End If
If wsAbout.Range("rnDeveloperOrUserMode") = "Developer" Then
subShowDeveloperMenu
End If
Exit Sub
ErrHandler1:
If Err.Number = 53 And ErrorTrapped = "No" Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #11"
ErrorMessage = "The environment variable %MS% is set to path which doesn't exist." & vbNewLine & _
"" & vbNewLine & _
"Some features such as help and automatically loading" & vbNewLine & _
"FDPXL Illustration Tester.xlsm will not work." & vbNewLine & _
"" & vbNewLine & _
"The value of %MS% is: " & MSEnvironmentVariable & vbNewLine & _
"This workbook is called: " & ActiveWorkbook.Name & vbNewLine & _
"and is located in: " & ActiveWorkbook.Path & vbNewLine & _
"" & vbNewLine & _
"To fix this, set the environment variable %MS% equal to the location of where" & vbNewLine & _
"MONEYSCIENCE LifeProfiler is installed and then restart Excel." & vbNewLine & _
"If the path and %MS% variable appear correct, don't forget to restart Excel." & vbNewLine & _
vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
If ErrorTrapped <> "Yes" Then
MsgBox (Err.Number & " " & Err.Description)
End If
Resume Next
ErrHandler2:
If Err.Number = 53 And ErrorTrapped = "No" Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #15"
ErrorMessage = "The help file is not present." & vbNewLine & _
"" & vbNewLine & _
"There should be a file called MoneyScience.chm in a subdirectory called \helpfiles" & vbNewLine & _
"off the directory listed in the environment variable %MS% and it is not there." & vbNewLine & _
"" & vbNewLine & _
"The value of %MS% is: " & MSEnvironmentVariable & vbNewLine & _
"" & vbNewLine & _
"For assistance contact: " & vbNewLine & _
"" & vbNewLine & _
" " & SupportContactName & vbNewLine & _
" " & gblvarSupportContactEmail & vbNewLine & _
" " & SupportContactPhone & vbNewLine
Response = MsgBox(ErrorMessage, Style, Title)
ErrorTrapped = "Yes"
End If
If ErrorTrapped <> "Yes" Then
MsgBox (Err.Number & " " & Err.Description)
End If
Resume Next
End Sub
Sub subErrorCheckWorksheetListing()
' Written by: Bill Brunt
' Date: 8/21/2009
' Purpose: This routine should be called from routines where events have been disabled, display is off as is calcuation.
' To check the worksheet listing contained in the wsPrintAreaConfiguration worksheet against those which exist
' and provide error checking to ensure that printing and other operations will perform as expected.
' This routine will run when the workbook opens and closes to ensure the list is maintained
' and error free. It will test that:
' 1) All existing worksheets in the workbook are listed in worksheets section of wsPrintAreaConfiguration.
' 2) All worksheets listed in the worksheets section of wsPrintAreaConfiguration exist as worksheets
' 3) The list is sorted by MoneyScience Worksheet Type and then Order Within Worksheet type and the SheetID are all
' in ascending order.
' 4) There is a Yes or No Value in "Hide For User Mode"
' 5) There is a value in the column MoneyScience Worksheet Type which exists in the range List_MoneyScience_Worksheet_Type
' 6) The column Order within Worksheet Type contains ascending values starting at 1 for each MoneyScience Worksheet Type
' 7) In the User has chosen to Print column, all rows contain either Yes or No.
' 8) Print Area should contain a valid range unless Hide for User Mode = "Yes" or Print Area is Variable = "Yes"
' 9) "Print Area is Variable" should contain "Yes" or "No" and also that there is a valid range in "Variable Print Area
' including first row" when "Print Area is Variable" is "Yes".
' 10) Ensure that the value in "Column for Tag Headings" is a valid column
' 11) Ensure that only "Hide For User Mode" = "Yes" have "-" in "Column for Tag Headings".
' 12) Ensure that "Column for Tag Headings" is within the defined print range
' 13) Check to see the column "Offset for Max Value" is within the defined print range.
' 14) See if it is a valid row range for the rows to repeat at thet top.
' 15) See that each entry in "Columns to Hide for Printing" is a Valid Column
' 16) Test for the Right Footer = "-" or it being unique.
' 17) Make sure the variable print area covers the used region.
'
' Modified: Who/Date/What
'
' Load all worksheets and their Index into an array
'
Dim svi As Integer
Dim svj As Integer
Dim svWorksheetsExisting(200, 4)
Dim svMONEYSCIENCEWorksheetType(100)
Dim svColumn As Long
Dim svStartingRow As Long
Dim svEndingRow As Long
Dim svColumn2 As Long
Dim svStartingRow2 As Long
Dim svEndingRow2 As Long
Dim svCurrentUserWorksheet As String
Dim svsomevar As String
Dim svtempvar As String
Dim svtempcol As String
Dim svtemprow As Integer
Dim svVariablePrintAreaStartingColumn As Integer
Dim svVariablePrintAreaTotalColumns As Integer
Dim svCurrentRegionStartingColumn As Integer
Dim svCurrrentRegionTotalColumns As Integer
Dim svEndingAddress As String
Dim svStartingAddress As String
Dim svEndingAddress2 As String
Dim svStartingAddress2 As String
Dim svExistsInwsPrintAreaConfiguration As Boolean
Dim svExistsInWorksheets As Boolean
Dim svValidWorksheetType As Boolean
Dim rgWorkSheetNames As Range
Dim rgIncludeInPrinting As Range
Dim rgSheetsToPrintListing As Range
Dim svApplicationCalculation As Long
Dim svApplicationScreenUpdating As Boolean
Dim svApplicationEnableEvents As Boolean
Dim svErrorNo As Integer
Dim svErrorMessage As String
Dim svColumnsToHideForPrinting As String
Dim svColumnToHide As String
Dim svCommaIsAt As Integer
Dim svWorksheetIndex(200) As Integer
Dim svWorksheetName(200) As String
Dim svWorksheetCodeName(200) As String
Dim svWorksheetHideForUserMode(200) As String
Dim svWorksheetMoneyScienceWorksheetType(200) As String
Dim svWorksheetOrderWithinWorksheetType(200) As Double
Dim svWorksheetUserHasChoosenToPrint(200) As String
Dim svWorksheetPrintArea(200) As String
Dim svWorksheetPrintAreaIsVariable(200) As String
Dim svWorksheetVariablePrintArea(200) As String
Dim svWorksheetColumnforTagHeadings(200) As String
Dim svWorksheetOffsetforMaxValue(200) As Integer
Dim svWorksheetRowsToRepeatAtTop(200) As String
Dim svWorksheetColumnsToHideForPrinting(200) As String
Dim svWorksheetRightFooter(200) As String
Dim svWorksheetFitPagesToTall(200) As String
Dim svWorksheetUniqueRightFooters(200) As String
Dim svWorksheetUniqueRightFootersCount(200) As Integer
Dim svVariablePrintAreaDef As String
Dim svCurrentRegion As String
Dim svWorksheetTotalUniqueRightFootersCount As Integer
Dim svWorksheetErrorFlag(200) As String
Dim svSheetsToPrintProtectContents As Boolean
svApplicationCalculation = Application.Calculation
svApplicationScreenUpdating = Application.ScreenUpdating
svApplicationEnableEvents = Application.EnableEvents
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
'
' Load the array of worksheets
'
For svi = 1 To Worksheets.Count
svWorksheetsExisting(svi, 1) = svi
svWorksheetsExisting(svi, 2) = Worksheets(svi).Name
svWorksheetsExisting(svi, 3) = Worksheets(svi).CodeName
Next svi
'
' Clear the index and put new formulas in
'
svColumn = wsPrintAreaConfiguration.Range("rgSheetID").Column
svStartingRow = wsPrintAreaConfiguration.Range("rgSheetID").Row + 1
svEndingRow = wsPrintAreaConfiguration.Range("rgSheetID").Row + wsPrintAreaConfiguration.Range("rgSheetID").CurrentRegion.Rows.Count - 1
svStartingAddress = Application.ConvertFormula("R" & svStartingRow & "C" & svColumn, xlR1C1, xlA1)
svEndingAddress = Application.ConvertFormula("R" & svEndingRow & "C" & svColumn, xlR1C1, xlA1)
wsPrintAreaConfiguration.Range(svStartingAddress & ":" & svEndingAddress).ClearContents
For svi = svStartingRow To svEndingRow
wsPrintAreaConfiguration.Cells(svi, svColumn).FormulaR1C1 = "=ufWorksheetid(RC[1])"
svsomevar = "=IF(RC[-3]=" & """" & "Yes" & """" & "," & """" & "No" & """" & _
",IF(ISNA(VLOOKUP(RC[-5],rgSheetsToPrintLookups,2,FALSE))," & """" & "Not set" & """" & _
",VLOOKUP(RC[-5],rgSheetsToPrintLookups,2,FALSE)))"
wsPrintAreaConfiguration.Cells(svi, svColumn + 6).FormulaR1C1 = svsomevar
Next svi
'
' Load array from listing in wsPrintAreaConfiguration
'
For svi = svStartingRow To svEndingRow
svWorksheetIndex(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn).Value
svWorksheetName(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 1).Value
svWorksheetCodeName(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 2).Value
svWorksheetHideForUserMode(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 3).Value
svWorksheetMoneyScienceWorksheetType(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 4).Value
svWorksheetOrderWithinWorksheetType(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 5).Value
If WorksheetFunction.IsNA(wsPrintAreaConfiguration.Cells(svi, svColumn + 6).Value) Then
svWorksheetUserHasChoosenToPrint(svi - svStartingRow + 1) = "#N/A"
Else
svWorksheetUserHasChoosenToPrint(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 6).Value
End If
svWorksheetPrintArea(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 7).Value
svWorksheetPrintAreaIsVariable(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 8).Value
svWorksheetVariablePrintArea(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 9).Value
svWorksheetColumnforTagHeadings(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 10).Value
svWorksheetOffsetforMaxValue(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 11).Value
svWorksheetRowsToRepeatAtTop(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 12).Value
svWorksheetColumnsToHideForPrinting(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 13).Value
svWorksheetRightFooter(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 14).Value
svWorksheetFitPagesToTall(svi - svStartingRow + 1) = wsPrintAreaConfiguration.Cells(svi, svColumn + 15).Value
Next svi
'
' With an array of the worksheets in existance and those in worksheets area of wsPrintAreaConfiguration, begin the tests. The first test is
' see if All existing worksheets in the workbook are listed in worksheets section of wsPrintAreaConfiguration.
'
For svj = 1 To Worksheets.Count
svExistsInwsPrintAreaConfiguration = False
For svi = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetName(svi) = svWorksheetsExisting(svj, 2) Then
svExistsInwsPrintAreaConfiguration = True
End If
Next svi
If Not svExistsInwsPrintAreaConfiguration Then
svWorksheetsExisting(svj, 4) = "Doesn't Exist"
End If
Next svj
'
' List all the worksheets which don't exist in wsPrintAreaConfiguration
'
For svj = 1 To Worksheets.Count
If svWorksheetsExisting(svj, 4) = "Doesn't Exist" Then
subDisplayError "MONEYSCIENCE Error Message #" & 22, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"This is an internal error and you should contact support." & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetsExisting(svj, 2) & """" & " is not in wsPrintAreaConfiguration.", _
vbOKOnly, _
True, _
22
End If
Next svj
'
' The next test is to see if All worksheets listed in the worksheets section of wsPrintAreaConfiguration exist as worksheets
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
svExistsInWorksheets = False
For svi = 1 To Worksheets.Count
If svWorksheetName(svj) = svWorksheetsExisting(svi, 2) Then
svExistsInWorksheets = True
End If
Next svi
If Not svExistsInWorksheets Then
svWorksheetErrorFlag(svj) = "Doesn't Exist"
Else
svWorksheetErrorFlag(svj) = ""
End If
Next svj
'
' List all the items in wsPrintAreaConfiguration which don't exist in worksheets
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetErrorFlag(svj) = "Doesn't Exist" Then
subDisplayError "MONEYSCIENCE Error Message #" & 23, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"This is an internal error and you should contact support." & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The wsPrintAreaConfiguration item " & """" & svWorksheetName(svj) & """" & " is not in Worksheets.", _
vbOKOnly, _
True, _
23
End If
Next svj
'
' Check that the worksheet indexes are ordered sequentially and contigously.
'
For svj = 1 To (svEndingRow - svStartingRow)
If svWorksheetIndex(svj) + 1 <> svWorksheetIndex(svj + 1) Then
subDisplayError "MONEYSCIENCE Error Message #" & 24, _
"The worksheets are not arranged in proper order for printing." & vbNewLine & _
"Please contact support, see the help topic Obtaining Support." & vbNewLine & _
"The wsPrintAreaConfiguration item worksheet index #" & """" & svWorksheetIndex(svj) & """" & _
" is followed by worksheet index # " & """" & svWorksheetIndex(svj + 1) & """", _
vbOKOnly, _
True, _
24
End If
Next svj
'
' Check there is a Yes/No in Hide For User Mode
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetHideForUserMode(svj) <> "Yes" And svWorksheetHideForUserMode(svj) <> "No" Then
subDisplayError "MONEYSCIENCE Error Message #" & 25, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"This is an internal error and you should contact support." & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The Hide for User Mode should be " & """" & "Yes" & " or " & """" & "No" & """" & vbNewLine & _
"and it is " & """" & svWorksheetHideForUserMode(svj) & """" & " for worksheet " & svWorksheetCodeName(svj), _
vbOKOnly, _
True, _
25
End If
Next svj
'
' Next test, make sure MONEYSCIENCE Worksheet type is set correctly and is ascending.
'
svColumn2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Column
svStartingRow2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Row
svEndingRow2 = wsLists.Range("List_MoneyScience_Worksheet_Type").Row + wsLists.Range("List_MoneyScience_Worksheet_Type").Rows.Count - 1
For svj = svStartingRow2 To svEndingRow2
svMONEYSCIENCEWorksheetType(svj - svStartingRow2 + 1) = wsLists.Cells(svj, svColumn2).Value
Next svj
For svj = 1 To (svEndingRow - svStartingRow + 1)
svValidWorksheetType = False
For svi = 1 To (svEndingRow2 - svStartingRow2 + 1)
If svWorksheetMoneyScienceWorksheetType(svj) = svMONEYSCIENCEWorksheetType(svi) Then
svValidWorksheetType = True
End If
Next svi
If Not svExistsInWorksheets Then
svWorksheetMoneyScienceWorksheetType(svj) = "Invalid or Missing MONEYSCIENCE Worksheet Type"
End If
Next svj
'
' List all the items in wsPrintAreaConfiguration with Invalid or missing worksheets
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetMoneyScienceWorksheetType(svj) = "Invalid or Missing MONEYSCIENCE Worksheet Type" Then
subDisplayError "MONEYSCIENCE Error Message #" & 26, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"This is an internal error and you should contact support." & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The wsPrintAreaConfiguration item " & """" & svWorksheetName(svj) & """" & " is either missing its MONEYSCIENCE worksheet type or is invalid.", _
vbOKOnly, _
True, _
26
End If
Next svj
'
' Check that the "Order with Worksheet Type" is ascending for each worksheet type
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetOrderWithinWorksheetType(svj) >= svWorksheetOrderWithinWorksheetType(svj + 1) And _
svWorksheetMoneyScienceWorksheetType(svj) = svWorksheetMoneyScienceWorksheetType(svj + 1) Then
subDisplayError "MONEYSCIENCE Error Message #" & 27, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"The " & """" & "Order within Worksheet Type" & """" & "is not in increasing order." & vbNewLine & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The worksheet " & svWorksheetName(svj) & " has an order of " & svWorksheetOrderWithinWorksheetType(svj) & _
" and is followed by worksheet " & svWorksheetName(svj + 1) & " which has an order of " & svWorksheetOrderWithinWorksheetType(svj + 1), _
vbOKOnly, _
True, _
27
End If
Next svj
'
' Check that the "User has chosen to Print" is either "Yes" or "No"
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetUserHasChoosenToPrint(svj) <> "Yes" And _
svWorksheetUserHasChoosenToPrint(svj) <> "No" Then
subDisplayError "MONEYSCIENCE Error Message #" & 28, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"The " & """" & "User has chosen to Print" & """" & " Column should be " & """" & "Yes" & """" & " or " & """" & "No" & """" & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The worksheet " & svWorksheetName(svj) & " has " & """" & svWorksheetUserHasChoosenToPrint(svj) & """", _
vbOKOnly, _
True, _
28
End If
Next svj
'
' Test # 8: Print Area should contain a valid range for "Hide for User Mode" = "No" And "Print Area is Variable" = "No"
'
On Error GoTo ErrNotValidRange:
svErrorNo = 30
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetHideForUserMode(svj) = "No" And _
svWorksheetPrintAreaIsVariable(svj) = "No" Then
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & svWorksheetName(svj) & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"contains the address " & """" & svWorksheetPrintArea(svj) & """" & _
" which is not a valid address range for Excel." & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
svsomevar = Range(svWorksheetPrintArea(svj)).Address
End If
Next svj
'
' Test #9, Check there is a Yes/No in "Print Area is Variable" and if it is "Yes", make sure
' sure there is a valid range defined.
'
svErrorNo = 33
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetPrintAreaIsVariable(svj) <> "Yes" And svWorksheetPrintAreaIsVariable(svj) <> "No" Then
subDisplayError "MONEYSCIENCE Error Message #" & 32, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"This is an internal error and you should contact support." & vbNewLine & _
"See the help topic Obtaining Support." & vbNewLine & _
"The " & """" & "Print Area is Variable" & """" & " should be " & """" & "Yes" & " or " & """" _
& "No" & """" & vbNewLine & _
"and it is " & """" & svWorksheetPrintAreaIsVariable(svj) & """" & " for worksheet " & svWorksheetCodeName(svj), _
vbOKOnly, _
True, _
32
End If
'
' When it is a variable print area, report the error
'
If svWorksheetPrintAreaIsVariable(svj) = "Yes" Then
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & svWorksheetName(svj) & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"contains the address for the " & """" _
& "Variable Print Area including first row" & """" & " of " & """" & svWorksheetPrintArea(svj) & """" & _
" which is not a valid address range for Excel." & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
svsomevar = Range(svWorksheetVariablePrintArea(svj)).Address
End If
Next svj
'
' Test #10: See if there are valid entries for columns in "Column for Tag Headings".
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetColumnforTagHeadings(svj) <> "-" And svWorksheetColumnforTagHeadings(svj) <> "Non Standard Heading" Then
svErrorNo = 34
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"contains the column for the " & """" _
& "Column for Tag Headings" & """" & " of " & """" & svWorksheetColumnforTagHeadings(svj) & """" & _
" which is not a valid column range Excel or it can contain " & """" & "Not Defined or Non Standard Heading" & """" & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
If Len(Range(svWorksheetColumnforTagHeadings(svj) & "1").Address) <> Len(Range(svWorksheetColumnforTagHeadings(svj) & "11").Address) Then
' This if will never execute but the conditions will error if it is not a valid column
End If
End If
Next svj
'
' Test #11: Ensure that only "Hide For User Mode" = "Yes" have "-" in "Column for Tag Headings".
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetColumnforTagHeadings(svj) = "-" And svWorksheetHideForUserMode(svj) <> "Yes" Then
svErrorNo = 37
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"contains the column for the " & """" & _
"Column for Tag Headings" & """" & " of " & """" & svWorksheetColumnforTagHeadings(svj) & """" & _
" which has " & """" & "Hide For User Mode = " & """" & "-" & """" & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
svErrorMessage, _
vbOKOnly, _
True, _
svErrorNo
End If
Next svj
'
' Test #12: Ensure that "Column for Tag Headings" is within the defined print range
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetColumnforTagHeadings(svj) = "-" And svWorksheetHideForUserMode(svj) <> "Yes" Then
If svWorksheetPrintAreaIsVariable(svj) = "Yes" Then
svsomevar = svWorksheetVariablePrintArea(svj)
Else
svsomevar = svWorksheetPrintArea(svj)
End If
If Range(svWorksheetColumnforTagHeadings(svj)).Column < Range(svsomevar).Column Or _
Range(svWorksheetColumnforTagHeadings(svj)).Column > Range(svsomevar).Column + Range(svsomevar).Columns.Count - 1 Then
svErrorNo = 38
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"has it's " & """" & _
"Column for Tag Headings" & """" & " outside of the print range " & """" & svsomevar & """" & _
"Contact support, see the help topic Obtaining Support for details."
subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
svErrorMessage, _
vbOKOnly, _
True, _
svErrorNo
End If
End If
Next svj
'
' Test #13: Check to see the column "Offset for Max Value" is within the defined print range.
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetHideForUserMode(svj) = "No" Then
If svWorksheetPrintArea(svj) = "-" Then
svsomevar = Range(svWorksheetVariablePrintArea(svj)).Columns.Count
Else
svsomevar = Range(svWorksheetPrintArea(svj)).Columns.Count
End If
If svWorksheetOffsetforMaxValue(svj) + 1 > CLng(svsomevar) Then
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"has a " & """" & "Offset for Max Value" & """" & " outside of the designated print range." & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
subDisplayError "MONEYSCIENCE Error Message #" & 35, _
svErrorMessage, _
vbOKOnly, _
True, _
35
End If
End If
Next svj
'
' Test # 14: See if it is a valid row range for the rows to repeat at thet top.
'
For svj = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetRowsToRepeatAtTop(svj) <> "-" Then
If Not IsNumeric(Mid(svWorksheetRowsToRepeatAtTop(svj), 2, InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") - 2)) Or _
Not IsNumeric(Mid(svWorksheetRowsToRepeatAtTop(svj), InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") + 2, 255)) Or _
Mid(svWorksheetRowsToRepeatAtTop(svj), 2, InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") - 2) > _
Mid(svWorksheetRowsToRepeatAtTop(svj), InStr(1, svWorksheetRowsToRepeatAtTop(svj), ":") + 2, 255) Then
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"has a " & """" & "Rows to Repeat at Top" & """" & " of " & """" & svWorksheetRowsToRepeatAtTop(svj) & """" & " which is invalid.." & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
subDisplayError "MONEYSCIENCE Error Message #" & 36, _
svErrorMessage, _
vbOKOnly, _
True, _
36
End If
End If
Next svj
'
' Test #15: to see that each entry in "Columns to Hide for Printing" is a Valid Column
'
svErrorNo = 37
For svj = 1 To (svEndingRow - svStartingRow + 1)
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet " & """" & svWorksheetName(svj) & """" & " for worksheet index " & """" & _
svWorksheetIndex(svj) & """" & vbNewLine & _
"has an invalid " & """" & "Columns To Hide for Printing" & """" & " of " & """" & svWorksheetColumnsToHideForPrinting(svj) & """" & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
svColumnsToHideForPrinting = svWorksheetColumnsToHideForPrinting(svj)
If svColumnsToHideForPrinting <> "-" Then
If InStr(1, svColumnsToHideForPrinting, ",") = 0 Then
svColumnToHide = Range("$" & svColumnsToHideForPrinting & "$1").Address
Else
Do
svCommaIsAt = InStr(1, svColumnsToHideForPrinting, ",")
svColumnToHide = Mid(svColumnsToHideForPrinting, 1, svCommaIsAt - 1)
svColumnToHide = "$" & svColumnToHide & "$" & "1"
svColumnToHide = Range(svColumnToHide).Address
svColumnsToHideForPrinting = Mid(svColumnsToHideForPrinting, svCommaIsAt + 1, 255)
Loop Until InStr(1, svColumnsToHideForPrinting, ",") = 0
svColumnToHide = "$" & svColumnsToHideForPrinting & "$" & "1"
svColumnToHide = Range(svColumnToHide).Address
End If
End If
Next svj
'
' Test #16: Ensure all the right footers are unique
'
'
wsScratch.Range("$A:$B").Clear
svsomevar = Application.ConvertFormula("R" & Range("rgSheetID").Row + 1 & "C" & _
wsPrintAreaConfiguration.Range("rnRightFooter").Column, xlR1C1, xlA1) _
& ":" & Application.ConvertFormula("R" & wsPrintAreaConfiguration.Range("rgSheetID").Row _
+ wsPrintAreaConfiguration.Range("rgSheetID").CurrentRegion.Rows.Count - 1 & "C" & _
wsPrintAreaConfiguration.Range("rnRightFooter").Column, xlR1C1, xlA1)
wsPrintAreaConfiguration.Range(svsomevar).Copy wsScratch.Range("$A$1")
Application.CutCopyMode = False
wsScratch.Range("$A$1").CurrentRegion.removeduplicates Columns:=1, Header:=xlNo
svWorksheetTotalUniqueRightFootersCount = wsScratch.Range("$A$1").CurrentRegion.Rows.Count
For svj = 1 To svWorksheetTotalUniqueRightFootersCount
svWorksheetUniqueRightFooters(svj) = wsScratch.Cells(svj, 1).Value
svWorksheetUniqueRightFootersCount(svj) = 0
Next svj
wsScratch.Range("$A:$B").Clear
'
'
'
For svi = 1 To (svEndingRow - svStartingRow + 1)
For svj = 1 To svWorksheetTotalUniqueRightFootersCount
If svWorksheetUniqueRightFooters(svj) = svWorksheetRightFooter(svi) And _
svWorksheetUniqueRightFooters(svj) <> "-" Then
svWorksheetUniqueRightFootersCount(svj) = svWorksheetUniqueRightFootersCount(svj) + 1
End If
Next svj
Next svi
'
' Report on duplicate footer usage
'
For svj = 1 To svWorksheetTotalUniqueRightFootersCount
If svWorksheetUniqueRightFootersCount(svj) > 1 And svWorksheetUniqueRightFooters(svj) <> "-" Then
svErrorMessage = "Printing may not function correctly." & vbNewLine & vbNewLine & _
"The worksheet footer " & """" & svWorksheetUniqueRightFooters(svj) & """" & " is used " & _
svWorksheetUniqueRightFootersCount(svj) & " times." & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details."
subDisplayError "MONEYSCIENCE Error Message #" & 39, _
svErrorMessage, _
vbOKOnly, _
True, _
39
End If
Next svj
'
' 17) Make sure the variable print area covers the used region.
'
For svi = 1 To (svEndingRow - svStartingRow + 1)
If svWorksheetPrintAreaIsVariable(svi) = "Yes" Then
'-------------------------------------------------------------------
svVariablePrintAreaDef = svWorksheetVariablePrintArea(svi) ' Need specific worksheet here
svVariablePrintAreaStartingColumn = Range(svVariablePrintAreaDef).Column
svVariablePrintAreaTotalColumns = Range(svVariablePrintAreaDef).Columns.Count
svtempvar = Mid(svVariablePrintAreaDef, InStr(1, svVariablePrintAreaDef, ":") + 1, 255)
svtempcol = Application.ConvertFormula("R1C" & Range(svtempvar).Column, xlR1C1, xlA1) ' Turn column # into valid xlA1 cell address
svtempcol = Mid(svtempcol, 2, InStr(2, svtempcol, "$") - 2)
svtemprow = Range(svtempvar).Row - 1
svCurrentRegion = Worksheets(svWorksheetIndex(svi)).Range("$" & svtempcol & "$" & svtemprow).CurrentRegion.Address ' Need specific worksheet here
svCurrentRegionStartingColumn = Range(svCurrentRegion).Column
svCurrrentRegionTotalColumns = Range(svCurrentRegion).Columns.Count
If svVariablePrintAreaStartingColumn <> svCurrentRegionStartingColumn Or _
svVariablePrintAreaTotalColumns <> svCurrrentRegionTotalColumns Then
End If
'-------------------------------------------------------------------
End If
Next svi
'
'
' For the items in wsPrintAreaConfiguration which are not hidden from the user, put them into wsSheetsToPrint
' and then copy them, paste special as values. Go to the original user entered values, clear these out and
' name the range rgSheetsToPrintLookups. If any of the values are not equal to Yes or No for Include in Printing,
' then set it to No as a default.
'
' The resason for doing this is that by creating the list of worksheets to print from wsPrintAreaConfiguration,
' this will always ensure that if reported errors were dealt with, the list in wsSheetsToPrint will be
' accurate and contain the users last settings.
'
'
svSheetsToPrintProtectContents = wsSheetsToPrint.ProtectContents
If svSheetsToPrintProtectContents Then
wsSheetsToPrint.Unprotect "Money"
End If
svi = 9 ' Starting row in Worksheets to Print where first worksheet can be found.
For svj = 1 To (svEndingRow - svStartingRow)
If svWorksheetHideForUserMode(svj) = "No" Then
wsSheetsToPrint.Cells(svi, 6).Value = svWorksheetName(svj)
If svWorksheetUserHasChoosenToPrint(svj) <> "Yes" And svWorksheetUserHasChoosenToPrint(svj) <> "No" Then
wsSheetsToPrint.Cells(svi, 7).Value = "No"
Else
wsSheetsToPrint.Cells(svi, 7).Value = svWorksheetUserHasChoosenToPrint(svj)
End If
svi = svi + 1
End If
Next svj
'
'
'
svCurrentUserWorksheet = ActiveSheet.Name
wsSheetsToPrint.Select
Set rgWorkSheetNames = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, -1))
Set rgIncludeInPrinting = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, 1))
Set rgSheetsToPrintListing = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1))
rgSheetsToPrintListing.Clear
wsSheetsToPrint.Range("F9").CurrentRegion.Copy wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").Offset(1)
'
' Since the copy may have created more rows, redefine the ranges
'
Set rgWorkSheetNames = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, -1))
Set rgIncludeInPrinting = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1, 1))
Set rgSheetsToPrintListing = Intersect(wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion, _
wsSheetsToPrint.Range("rgSheetsToPrintWorksheetName").CurrentRegion.Offset(1))
wsSheetsToPrint.Range("F:G").Delete
rgWorkSheetNames.Style = "RH Text Left Center"
rgIncludeInPrinting.Style = "Input Text Center"
With rgIncludeInPrinting.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=List_YesNo"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'
' Redefine the range rgSheetsToPrintLookups
'
With ActiveWorkbook.Names("rgSheetsToPrintLookups")
.Name = "rgSheetsToPrintLookups"
.RefersToR1C1 = "='Sheets To Print'!" & rgSheetsToPrintListing.Address(True, True, xlR1C1)
.Comment = ""
End With
'
'
'
If svSheetsToPrintProtectContents Then
wsSheetsToPrint.Protect "Money"
End If
'
' Restore calculation, screen updating and enable events settings
'
Application.Calculation = svApplicationCalculation
Application.ScreenUpdating = svApplicationScreenUpdating
Application.EnableEvents = svApplicationEnableEvents
Worksheets(svCurrentUserWorksheet).Select
Exit Sub
ErrNotValidRange:
If Err.Number = 1004 Then
subDisplayError "MONEYSCIENCE Error Message #" & svErrorNo, _
svErrorMessage, _
vbOKOnly, _
True, _
svErrorNo
Resume Next
Else
subDisplayError "MONEYSCIENCE Error Message #" & 31, _
"Printing may not function correctly." & vbNewLine & vbNewLine & _
"Error Code: " & Err.Number & vbNewLine & _
"Error Description: " & Err.Description & vbNewLine & _
"Contact support, see the help topic Obtaining Support for details.", _
vbOKOnly, _
True, _
31
Resume Next
End If
End Sub
'
'
Sub subGetCurrentVersionFromTheWeb()
Dim Style As Long
Dim Title As String
Dim ErrorMessage As String
Dim Response As Variant
On Error GoTo ErrHandlerNoWebFile:
Workbooks.Open ("[URL]http://www.bandgservices.com/Documents/CurrentVersion.txt[/URL]")
pvLifeProfilerVersion = Workbooks("CurrentVersion.txt").Worksheets("CurrentVersion").Range("A1").Value
Workbooks("CurrentVersion.txt").Close
Exit Sub
ErrHandlerNoWebFile:
If Err.Number = 1004 Then
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #19"
ErrorMessage = "In all likelihood, you are not connected to the Internet. All this means is that MONEYSCIENCE's LifeProfiler" & vbNewLine & _
"will not be able to check for a more recent version of the software." & vbNewLine & vbNewLine & _
"If you are connected and have verified this, then contact support." & vbNewLine & vbNewLine & _
"See the help topic Obtaining Support for details."
Response = MsgBox(ErrorMessage, Style, Title)
Else
Style = vbOKOnly ' Define buttons.
Title = "MoneyScience Error Message #20"
ErrorMessage = "An unknown error has occurred. Please take a screen shot or write down all the " & vbNewLine & _
"details of this message and then contact support." & vbNewLine & vbNewLine & _
"See the help topic Obtaining Support for details." & vbNewLine & vbNewLine & _
"Err.Number = " & Err.Number & ": " & Err.Description
Response = MsgBox(ErrorMessage, Style, Title)
End If
End Sub
'Note: Do not change the code above
Sub subShowDeveloperMenu()
Call RefreshRibbon(Tag:="MSDeveloperGroupTag")
End SubI suspect there may subroutines I've not includded but if you've read this and want more, let me know.
