'#Reference {00020813-0000-0000-C000-000000000046}#1.3#0#C:\Program Files\Microsoft Office\Office\EXCEL9.OLB#Microsoft Excel 9.0 Object Library
' SpecCalc5nm.bas for FilmStar DESIGN
' Copyright 2009-2011 FTG Software Associates
'
' ****************************************************
'    Warning: Save modified program with new name!!!
' ****************************************************
'
' Automates 5 nm Spectral Calculator © Bruce Lindbloom
' See http://brucelindbloom.com
'
' Macro does not require that Excel be open.
'
' IMPORTANT...It may be necessary to re-establish a reference
' to the Excel Object Library (Edit..References)
'
' Evaluation range must be 380-780x5 nm
'
Option Explicit
Option Base 1
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Const ttl$ = "Lindbloom Spectral Calculator"
Const fmt$ = "0.00"

Sub Main
    Dim i, k, s$(2), ndata, xdata!(), ydata!()
    On Error GoTo ExcelQuit
    s$(1) = "Refl ": s$(2) = "Trns "
    AxesDraw: CalcPlot
    xdata = Spectrum_X
    ydata = Spectrum_Y
    ndata = UBound(xdata)
    If ndata <> 81 Or xdata(1) <> 380 Or xdata(ndata) <> 780 Then
        MsgBox "Not FilmStar CIE range 380-780 x 5 nm", vbCritical, ttl$
        End
    End If
    OpenXlsFile PgmPath$ & "\SpectralCalculator5nm.xls"
    With xlSheet
        For k = 1 To 2
            For i = 10 To 108   ' 340 to 830 nm
                If i < 18 Or i > 98 Then
                    .Cells(i, 3) = 0
                Else            ' only use 380-780 nm
                    .Cells(i, 3) = ydata(i - 17, k)  ' k: 1 Refl 2 Trns
                End If
            Next i
            xlSheet.Calculate   ' recalculate now
            MsgBox s$(k) & "2° Illum E: L = " & Format$(.Cells(8, 13), fmt$) _
                   & ", C(uv) = " & Format$(.Cells(8, 20), fmt$) _
                   & ", H(uv) = " & Format$(.Cells(8, 21), fmt$), ttl$
        Next k
    End With
ExcelQuit:
    On Error Resume Next
    xlApp.Quit  ' Close Excel
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

Sub OpenXlsFile(ByVal f$)
    ' If you get an error in the next line, you need to re-establish
    ' a reference to the Microsoft Excel Object Library
    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open(f$)
    Set xlSheet = xlBook.Sheets(1)
    xlApp.Calculation = xlCalculationManual ' faster
    xlApp.DisplayAlerts = False ' no save prompt upon exiting Excel
End Sub