Attribute VB_Name = "modReport"
' Copyright (C) 2007 Stephane Germain <stephane.germain@gmail.com>
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or (at
' your option) any later version.
'
' This program is distributed in the hope that it will be useful, but
' WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA

Option Explicit
Option Base 1

Public Sub WriteCell(ws As Worksheet, row As Integer, col As Integer, _
    Value As Variant, Optional NumberFormat As String, _
    Optional HorizontalAlignment As XlHAlign, _
    Optional VerticalAlignment As XlVAlign, _
    Optional Underline As Boolean, Optional Bold As Boolean, _
    Optional Italic As Boolean, Optional WrapText As Boolean, _
    Optional FontSize As Integer)
    
    ws.Cells(row, col) = Value
    If Not IsMissing(NumberFormat) Then ws.Cells(row, col).NumberFormat = NumberFormat
    If HorizontalAlignment <> 0 Then ws.Cells(row, col).HorizontalAlignment = HorizontalAlignment
    If VerticalAlignment <> 0 Then ws.Cells(row, col).VerticalAlignment = VerticalAlignment
    If Not IsMissing(Underline) Then ws.Cells(row, col).Font.Underline = Underline
    If Not IsMissing(Bold) Then ws.Cells(row, col).Font.Bold = Bold
    If Not IsMissing(Italic) Then ws.Cells(row, col).Font.Italic = Italic
    If Not IsMissing(WrapText) Then ws.Cells(row, col).WrapText = WrapText
    If FontSize <> 0 Then ws.Cells(row, col).Font.Size = FontSize
End Sub

Public Function makeChart(ws As Worksheet, row As Integer, col As Integer, _
    xValues() As Double, yValues() As Double, _
    Optional height As Integer = 24, Optional width As Integer = 6, _
    Optional name As String = "serie1", Optional Title As String = "Plot", _
    Optional xTitle As String = "x", Optional yTitle As String = "y", _
    Optional yMin As Double = -10000, Optional yMax As Double = 10000) As ChartObject
    
    Dim co As ChartObject
    
    Dim chartTop, chartLeft, chartWidth, chartHeight As Integer
    chartTop = ws.Cells(row, col).Top
    chartLeft = ws.Cells(row, col).Left
    chartHeight = ws.Cells(row + height, col).Top - ws.Cells(row, col).Top
    chartWidth = ws.Cells(row, col + width).Left - ws.Cells(row, col).Left
    Set co = ws.ChartObjects.Add(chartLeft, chartTop, chartWidth, chartHeight)
    
    With co.Chart
        .ChartType = xlXYScatterSmoothNoMarkers
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Values = Array(yValues)
        .SeriesCollection(1).xValues = Array(xValues)
        .SeriesCollection(1).name = name
        .SeriesCollection(1).ChartType = xlXYScatterSmoothNoMarkers
        .HasLegend = False
        .ChartTitle.Font.Size = 10
        .ChartTitle.Font.Bold = True
        .ChartTitle.Text = Title
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = yTitle
        .Axes(xlValue).HasMajorGridlines = False
        If yMin > -1000 Then
            .Axes(xlValue).MinimumScaleIsAuto = False
            .Axes(xlValue).MinimumScale = yMin
        End If
        If yMax < 1000 Then
            .Axes(xlValue).MaximumScaleIsAuto = False
            .Axes(xlValue).MaximumScale = yMax
        End If
        .Axes(xlCategory).MinimumScaleIsAuto = False
        .Axes(xlCategory).MinimumScale = xValues(1)
        .Axes(xlCategory).MaximumScaleIsAuto = False
        .Axes(xlCategory).MaximumScale = xValues(UBound(xValues))
        .Axes(xlCategory).CrossesAt = xValues(1)
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = xTitle
        .PlotArea.Interior.Color = RGB(255, 255, 255)
    End With
    
    Set makeChart = co
End Function

Public Sub addSerie(co As ChartObject, name As String, xValues() As Double, yValues() As Double)
    Dim i As Integer
    'If co.Chart.SeriesCollection.Count = 1 Then co.width = Int(co.width * 1.1)
    With co.Chart
        .HasLegend = True
        .SeriesCollection.NewSeries
        i = co.Chart.SeriesCollection.Count
        .SeriesCollection(i).Values = Array(yValues)
        .SeriesCollection(i).xValues = Array(xValues)
        .SeriesCollection(i).name = name
        .SeriesCollection(i).ChartType = xlXYScatterSmoothNoMarkers
    End With
End Sub

Public Sub WirtReport()
    
    ' disable automatic recalculation
    Dim calcState As XlCalculation
    calcState = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    On Error GoTo errorEnd
    continue_on_error (1)
    
    Dim patternsPtr() As Long
    Dim slopesPtr() As Double
    Dim threshPtr() As Double
    Dim asympPtr() As Double
    Dim slopesSdPtr() As Double
    Dim threshSdPtr() As Double
    Dim asympSdPtr() As Double
    Dim quadPointsPtr() As Double
    Dim quadWeightsPtr() As Double
    Dim probsPtr() As Double
    Dim probsSdPtr() As Double
    Dim iccPtr() As Double
    Dim iccSdPtr() As Double
    Dim abilitiesPtr() As Double
    Dim abilitiesSdPtr() As Double
    Dim nbrNotConverge As Long
    Dim notConvergePtr() As Long
    Dim nbrIgnore As Long
    Dim ignorePtr() As Long
    Dim gradedFlag As Long
    Dim penalizedFlag As Long
    Dim kernelFlag As Long
    Dim groupingFlag As Long
    Dim model As Long
    Dim slopeinit As Double
    Dim threshInit As Double
    Dim asympInit As Double
    Dim slopePriorFlag As Long
    Dim threshPriorFlag As Long
    Dim asympPriorFlag As Long
    Dim smoothFactor As Double
    Dim optionsWeightsPtr() As Double
    Dim NbrOptionTot As Long
    Dim itemsPosPtr() As Long
    Dim nbrOptionsPtr() As Long
    Dim minimums() As Long
    Dim maximums() As Long
    Dim patternsExpPtr() As Long
    Dim OptionsCol() As Collection
    Dim OptionsNames() As Collection
    Dim pattern As String
    Dim optCode As Long
    Dim i, j, k, o, pos, nbrOption As Integer
    Dim infosPtr() As Double
    Dim testInfoPtr() As Double
    Dim optionsInfosPtr() As Double
    Dim fitChi2Ptr() As Double
    Dim fitDfPtr() As Long
    Dim fitPValuePtr() As Double
    Dim ldChi2Ptr() As Double
    Dim ldDfPtr() As Long
    Dim ldPValuePtr() As Double
    Dim itemsMeanPtr() As Double
    Dim itemsSdPtr() As Double
    Dim itemsCorrPtr() As Double
    Dim itemsPolyCorrPtr() As Double
    Dim pairsCorrPtr() As Double
    Dim itemsNbrPtr() As Long
    Dim subjectsScorePtr() As Double
    Dim subjectsNbrPtr() As Long
    Dim nbr As Long
    Dim mean As Double
    Dim sd As Double
    Dim alpha As Double
    Dim emConverge As Long
    Dim ogiveD As Double
    
    If NormalOgive = 1 Then
        ogiveD = 1.702
    Else
        ogiveD = 1
    End If
    model = 0
    penalizedFlag = 0
    kernelFlag = 0
    slopeinit = SlopeMean
    threshInit = ThreshMean
    asympInit = 0
    If PLM1 Then
        model = 1
        slopeinit = FixedSlope
    ElseIf PLM2 Or NominalModel Or GradedModel Then
        model = 2
    ElseIf PLM3 Then
        model = 3
        asympInit = AsympMean
    ElseIf Penalized Then
        penalizedFlag = 1
        smoothFactor = PenalizedFactor * NbrSubject ^ 0.2
    ElseIf Kernel Then
        kernelFlag = 1
        smoothFactor = KernelFactor * NbrSubject ^ -0.2
    End If
    If Grouping Then
        groupingFlag = 1
    Else
        groupingFlag = 0
    End If
    If GradedModel Then
        gradedFlag = 1
        If threshInit <= 0 Then threshInit = 1
    Else
        gradedFlag = 0
    End If
    ' if MC but with a bivariate model then it's really binary
    If MC And (PLM1 Or PLM2 Or PLM3) Then
        MC = False
        Binary = True
    End If
    
    Application.Cursor = xlWait
    
    ' Copy the patterns in a big vector (in row order first)
    ReDim nbrOptionsPtr(NbrItem) As Long
    ReDim minimums(NbrItem) As Long
    ReDim maximums(NbrItem) As Long
    ReDim itemsPosPtr(NbrItem) As Long
    ReDim OptionsCol(NbrItem) As Collection
    ReDim OptionsNames(NbrItem) As Collection
    ReDim patternsPtr(NbrSubject * NbrItem) As Long
    For i = 1 To NbrItem
        nbrOptionsPtr(i) = 0
        minimums(i) = 9999
        maximums(i) = -9999
        Set OptionsCol(i) = New Collection
        Set OptionsNames(i) = New Collection
        For j = 1 To NbrSubject
            pattern = Trim(CStr(RawData(j, i)))
            If pattern = MissingString Or _
                (IsEmpty(RawData(j, i)) And MissingString = "") Then
                patternsPtr((j - 1) * NbrItem + i) = BlankCode
            ElseIf Binary Then
                If pattern = Key(i) Then
                    patternsPtr((j - 1) * NbrItem + i) = TrueCode
                    'check if the two options are found
                    If nbrOptionsPtr(i) = 0 Then
                        nbrOptionsPtr(i) = 1 ' only success so far
                    ElseIf nbrOptionsPtr(i) = 2 Then
                        nbrOptionsPtr(i) = 3 ' success and failure found
                    End If
                Else
                    patternsPtr((j - 1) * NbrItem + i) = FalseCode
                    'check if the two options are found
                    If nbrOptionsPtr(i) = 0 Then
                        nbrOptionsPtr(i) = 2 ' only failure so far
                    ElseIf nbrOptionsPtr(i) = 1 Then
                        nbrOptionsPtr(i) = 3 ' success and failure found
                    End If
                End If
            ElseIf DataTypes(i) = NominalModelCode Then
                If Exists(OptionsCol(i), pattern) Then
                    optCode = OptionsCol(i).item(pattern)
                Else
                    optCode = OptionsCol(i).Count + 1
                    OptionsCol(i).Add optCode, pattern
                    OptionsNames(i).Add pattern, CStr(optCode)
                End If
                patternsPtr((j - 1) * NbrItem + i) = optCode
            ElseIf DataTypes(i) = GradedModelCode Then
                If Not IsNumeric(pattern) Then
                    MsgBox GText("msgResponseNan", j, i) & _
                        GText("msgTryAgain"), vbApplicationModal, ProgName
                    RawData.Cells(j, i).Select
                    GoTo normalEnd
                End If
                If Round(Val(pattern)) <> Val(pattern) Then
                    MsgBox GText("msgResponseNan", j, i) & _
                        GText("msgTryAgain"), vbApplicationModal, ProgName
                    RawData.Cells(j, i).Select
                    GoTo normalEnd
                End If
                optCode = Int(Val(pattern))
                If maximums(i) < optCode Then maximums(i) = optCode
                If minimums(i) > optCode Then minimums(i) = optCode
                ' hack : to differentiate a negative options from a blank (-1)
                If optCode <= BlankCode Then optCode = optCode - 1
                patternsPtr((j - 1) * NbrItem + i) = optCode
            End If
        Next j
        ' check if at least two options are there
        If Binary Then
            If nbrOptionsPtr(i) = 2 Then
                nbrOptionsPtr(i) = 1
            ElseIf nbrOptionsPtr(i) = 3 Then
                nbrOptionsPtr(i) = 2
            End If
        ElseIf DataTypes(i) = NominalModelCode Then
            nbrOptionsPtr(i) = OptionsNames(i).Count
            Dim OrderedNames As Collection
            Set OrderedNames = OrderOptions(OptionsNames(i), OptionsCol(i))
            For j = 1 To NbrSubject
                optCode = patternsPtr((j - 1) * NbrItem + i)
                If optCode <> BlankCode Then
                    pattern = OptionsNames(i).item(CStr(optCode))
                    patternsPtr((j - 1) * NbrItem + i) = OptionsCol(i).item(pattern)
                End If
            Next j
            Set OptionsNames(i) = OrderedNames
        ElseIf DataTypes(i) = GradedModelCode Then
            nbrOptionsPtr(i) = maximums(i) - minimums(i) + 1
            ' recode the options from 1
            If minimums(i) <> 1 Then
                For j = 1 To NbrSubject
                    optCode = patternsPtr((j - 1) * NbrItem + i)
                    If optCode <> BlankCode Then
                        ' see the previous hack
                        If optCode < BlankCode Then optCode = optCode + 1
                        optCode = optCode - minimums(i) + 1
                        patternsPtr((j - 1) * NbrItem + i) = optCode
                    End If
                Next j
            End If
        End If
        If nbrOptionsPtr(i) < 2 Then
            MsgBox GText("msgAtLeast2Option", i) & _
                GText("msgTryAgain"), vbApplicationModal, ProgName
            GoTo normalEnd
        End If
    Next i
    
    ' Allocate the memory for the output
    ReDim notConvergePtr(NbrItem) As Long
    ReDim ignorePtr(NbrItem) As Long
    ReDim quadPointsPtr(NbrQuad) As Double
    ReDim quadWeightsPtr(NbrQuad) As Double
    ReDim abilitiesPtr(NbrSubject) As Double
    ReDim abilitiesSdPtr(NbrSubject) As Double
    
    If Information Then
        ReDim infosPtr(NbrItem * NbrQuad) As Double
        ReDim testInfoPtr(NbrQuad) As Double
    End If
    
    If Fit Then
        ReDim fitChi2Ptr(NbrItem + 1) As Double
        ReDim fitDfPtr(NbrItem + 1) As Long
        ReDim fitPValuePtr(NbrItem + 1) As Double
    End If
    
    If LD Then
        ReDim ldChi2Ptr(NbrItem * NbrItem) As Double
        ReDim ldDfPtr(NbrItem * NbrItem) As Long
        ReDim ldPValuePtr(NbrItem * NbrItem) As Double
    End If
    
    If CTT Or PairsCorr Or Score Then
        ReDim itemsMeanPtr(NbrItem) As Double
        ReDim itemsSdPtr(NbrItem) As Double
        ReDim itemsCorrPtr(NbrItem) As Double
        ReDim itemsPolyCorrPtr(NbrItem) As Double
        ReDim pairsCorrPtr(NbrItem * NbrItem) As Double
        ReDim itemsNbrPtr(NbrItem) As Long
        ReDim subjectsScorePtr(NbrSubject) As Double
        ReDim subjectsNbrPtr(NbrSubject) As Long
    End If
    
    If Binary Then
        ReDim slopesPtr(NbrItem) As Double
        ReDim threshPtr(NbrItem) As Double
        ReDim asympPtr(NbrItem) As Double
        ReDim slopesSdPtr(NbrItem) As Double
        ReDim threshSdPtr(NbrItem) As Double
        ReDim asympSdPtr(NbrItem) As Double
        ReDim probsPtr(NbrItem * NbrQuad) As Double
        ReDim probsSdPtr(NbrItem * NbrQuad) As Double
    Else
        ' count the total number of options and positions
        NbrOptionTot = 0
        For i = 1 To NbrItem
            itemsPosPtr(i) = NbrOptionTot
            NbrOptionTot = NbrOptionTot + nbrOptionsPtr(i)
        Next i

        ReDim iccPtr((NbrItem + 1) * NbrQuad) As Double
        ReDim iccSdPtr((NbrItem + 1) * NbrQuad) As Double
        
        If Information Then
            ReDim optionsInfosPtr(NbrOptionTot * NbrQuad) As Double
            ReDim testInfoPtr(NbrQuad) As Double
        End If
        
        ' create the options weights
        ReDim optionsWeightsPtr(NbrOptionTot) As Double
        For i = 1 To NbrItem
            For o = 1 To nbrOptionsPtr(i)
                If DataTypes(i) = NominalModelCode Then
                    If OptionsNames(i).item(CStr(o)) = Key(i) Then
                        optionsWeightsPtr(itemsPosPtr(i) + o) = 1
                    Else
                        optionsWeightsPtr(itemsPosPtr(i) + o) = 0
                    End If
                ElseIf DataTypes(i) = GradedModelCode Then
                    optionsWeightsPtr(itemsPosPtr(i) + o) = o
                    OptionsCol(i).Add o, CStr(o)
                    OptionsNames(i).Add CStr(o + minimums(i) - 1), CStr(o)
                End If
            Next o
        Next i
    
        ReDim slopesPtr(NbrOptionTot) As Double
        ReDim threshPtr(NbrOptionTot) As Double
        ReDim slopesSdPtr(NbrOptionTot) As Double
        ReDim threshSdPtr(NbrOptionTot) As Double
        ReDim probsPtr(NbrOptionTot * NbrQuad) As Double
        ReDim probsSdPtr(NbrOptionTot * NbrQuad) As Double
        ReDim patternsExpPtr(NbrSubject * NbrOptionTot) As Long
    End If
    
    ' Initialize the slopes
    If Binary And Not Kernel And Not Penalized Then
        For i = 1 To NbrItem
            slopesPtr(i) = slopeinit
            threshPtr(i) = threshInit
            asympPtr(i) = asympInit
        Next i
    End If
    
'    GoTo skipDll
    
    ' Call the function in the dll
    Err.Clear
    If Binary Then
        Call irt_wrapper(NbrSubject, NbrItem, patternsPtr(1), _
            NbrQuad, QuadFrom, QuadTo, _
            model, penalizedFlag, kernelFlag, smoothFactor, _
            SlopePrior, ThreshPrior, AsympPrior, SlopeMean, SlopeDev, _
            ThreshMean, ThreshDev, AsympMean, AsympWeight, _
            MaxEMiter, MaxNRiter, Precision, groupingFlag, _
            slopesPtr(1), threshPtr(1), asympPtr(1), _
            slopesSdPtr(1), threshSdPtr(1), asympSdPtr(1), _
            quadPointsPtr(1), quadWeightsPtr(1), _
            probsPtr(1), probsSdPtr(1), _
            nbrNotConverge, notConvergePtr(1), _
            nbrIgnore, ignorePtr(1), 0, 0, emConverge)
        
        If CTT Or PairsCorr Or Score Then
            Call classical_statistics_wrapper(NbrSubject, NbrItem, patternsPtr(1), _
                itemsMeanPtr(1), itemsSdPtr(1), itemsCorrPtr(1), itemsPolyCorrPtr(1), itemsNbrPtr(1), _
                subjectsScorePtr(1), subjectsNbrPtr(1), nbr, mean, sd, alpha, pairsCorrPtr(1))
        End If
    
        If Ability Then
            If AbilEstim = GText("optEAP") Then
                Call eap_abilities_wrapper(NbrSubject, NbrItem, NbrQuad, _
                    patternsPtr(1), probsPtr(1), quadPointsPtr(1), quadWeightsPtr(1), _
                    abilitiesPtr(1), abilitiesSdPtr(1))
            Else
                Call wmle_abilities_wrapper(MaxNRiter, Precision, NbrSubject, NbrItem, NbrQuad, _
                    patternsPtr(1), probsPtr(1), quadPointsPtr(1), _
                    abilitiesPtr(1), abilitiesSdPtr(1))
            End If
        End If
        
        If Information Then
            Call info_from_probs_wrapper(NbrItem, NbrQuad, probsPtr(1), _
                quadPointsPtr(1), infosPtr(1), testInfoPtr(1))
        End If
    
        If Fit Then
            Call llk_ratio_fit_test_wrapper(NbrSubject, NbrItem, NbrQuad, _
                patternsPtr(1), quadWeightsPtr(1), probsPtr(1), 11, _
                fitChi2Ptr(1), fitDfPtr(1), fitPValuePtr(1))
        End If
        
        If LD Then
            Call llk_ratio_ld_test_wrapper(NbrSubject, NbrItem, NbrQuad, patternsPtr(1), _
                probsPtr(1), quadWeightsPtr(1), ldChi2Ptr(1), ldDfPtr(1), ldPValuePtr(1))
        End If
    Else
        If Not Mixed Then
            Call mirt_wrapper(NbrSubject, NbrItem, NbrOptionTot, _
                itemsPosPtr(1), nbrOptionsPtr(1), _
                patternsPtr(1), optionsWeightsPtr(1), _
                NbrQuad, QuadFrom, QuadTo, _
                penalizedFlag, kernelFlag, smoothFactor, gradedFlag, _
                MaxEMiter, MaxNRiter, Precision, groupingFlag, _
                slopesPtr(1), threshPtr(1), _
                slopesSdPtr(1), threshSdPtr(1), _
                slopeinit, threshInit, _
                quadPointsPtr(1), quadWeightsPtr(1), _
                probsPtr(1), probsSdPtr(1), _
                iccPtr(1), iccSdPtr(1), _
                nbrNotConverge, notConvergePtr(1), _
                nbrIgnore, ignorePtr(1), 0, patternsExpPtr(1), 0, emConverge)
        Else
            Call mixed_wrapper(NbrSubject, NbrItem, NbrOptionTot, _
                Models(1), Models(1), _
                itemsPosPtr(1), nbrOptionsPtr(1), _
                patternsPtr(1), optionsWeightsPtr(1), _
                NbrQuad, QuadFrom, QuadTo, _
                smoothFactor, _
                MaxEMiter, MaxNRiter, Precision, groupingFlag, _
                slopesPtr(1), threshPtr(1), _
                slopesSdPtr(1), threshSdPtr(1), _
                slopeinit, threshInit, _
                quadPointsPtr(1), quadWeightsPtr(1), _
                probsPtr(1), probsSdPtr(1), _
                iccPtr(1), iccSdPtr(1), _
                nbrNotConverge, notConvergePtr(1), _
                nbrIgnore, ignorePtr(1), 0, patternsExpPtr(1), emConverge)
        End If
        
        If CTT Or PairsCorr Or Score Then
            Call classical_statistics_mc_wrapper( _
                NbrOptionTot, NbrSubject, NbrItem, _
                patternsPtr(1), optionsWeightsPtr(1), _
                itemsPosPtr(1), nbrOptionsPtr(1), _
                itemsMeanPtr(1), itemsSdPtr(1), _
                itemsCorrPtr(1), itemsPolyCorrPtr(1), itemsNbrPtr(1), _
                subjectsScorePtr(1), subjectsNbrPtr(1), _
                nbr, mean, sd, alpha, pairsCorrPtr(1))
        End If
    
        If Ability Then
            If AbilEstim = GText("optEAP") Then
                Call eap_abilities_mc_wrapper(NbrSubject, NbrItem, NbrQuad, NbrOptionTot, _
                    itemsPosPtr(1), nbrOptionsPtr(1), _
                    patternsExpPtr(1), probsPtr(1), quadPointsPtr(1), quadWeightsPtr(1), _
                    abilitiesPtr(1), abilitiesSdPtr(1))
            Else
                Call wmle_abilities_mc_wrapper(MaxNRiter, Precision, NbrSubject, NbrItem, NbrQuad, NbrOptionTot, _
                    nbrOptionsPtr(1), itemsPosPtr(1), _
                    patternsExpPtr(1), probsPtr(1), quadPointsPtr(1), _
                    abilitiesPtr(1), abilitiesSdPtr(1))
            End If
        End If
        
        If Information Then
            Call info_from_probs_mc_wrapper(NbrItem, NbrOptionTot, NbrQuad, probsPtr(1), _
                quadPointsPtr(1), nbrOptionsPtr(1), itemsPosPtr(1), optionsInfosPtr(1), _
                infosPtr(1), testInfoPtr(1))
        End If
    
        If Fit Then
            Call llk_ratio_fit_test_mc_wrapper(NbrSubject, NbrItem, NbrQuad, NbrOptionTot, _
                patternsExpPtr(1), quadWeightsPtr(1), probsPtr(1), _
                nbrOptionsPtr(1), itemsPosPtr(1), _
                11, fitChi2Ptr(1), fitDfPtr(1), fitPValuePtr(1))
        End If
        
        If LD Then
            Call llk_ratio_ld_test_mc_wrapper(NbrSubject, NbrItem, NbrQuad, NbrOptionTot, _
                patternsPtr(1), probsPtr(1), quadWeightsPtr(1), _
                nbrOptionsPtr(1), itemsPosPtr(1), _
                ldChi2Ptr(1), ldDfPtr(1), ldPValuePtr(1))
        End If
    End If
    If Err.Number <> 0 Then GoTo errorEnd
    Err.Clear
    
skipDll:

    ' if graded model then copy the unique slope to each option
    If GradedModel Then
        For i = NbrItem To 1 Step -1
            pos = itemsPosPtr(i)
            For o = nbrOptionsPtr(i) To 1 Step -1
                slopesPtr(pos + o) = slopesPtr(i)
                slopesSdPtr(pos + o) = slopesSdPtr(i)
            Next o
        Next i
    End If
    
    ' if normal ogive the correct the slopes
    If NormalOgive = 1 And Not Penalized And Not Kernel Then
        For i = 1 To NbrItem
            If Binary Then
                pos = i - 1
                nbrOption = 1
            Else
                pos = itemsPosPtr(i)
                nbrOption = nbrOptionsPtr(i)
            End If
            For o = 1 To nbrOption
                slopesPtr(pos + o) = slopesPtr(pos + o) / ogiveD
                slopesSdPtr(pos + o) = slopesSdPtr(i) / ogiveD
            Next o
        Next i
    End If
    
    ' if graded data then correct the means
    For i = NbrItem To 1 Step -1
        If DataTypes(i) = GradedModelCode Then
            If CTT Then itemsMeanPtr(i) = itemsMeanPtr(i) + minimums(i) - 1
            mean = mean + minimums(i) - 1
        End If
    Next i
    ' recompute the scores
    If Score Then
        For j = 1 To NbrSubject
            subjectsScorePtr(j) = 0
            For i = 1 To NbrItem
                optCode = patternsPtr((j - 1) * NbrItem + i)
                If optCode <> BlankCode Then
                    If Binary Then
                        subjectsScorePtr(j) = subjectsScorePtr(j) + _
                            optCode
                    ElseIf DataTypes(i) = NominalModelCode Then
                        subjectsScorePtr(j) = subjectsScorePtr(j) + _
                            optionsWeightsPtr(itemsPosPtr(i) + optCode)
                    ElseIf DataTypes(i) = GradedModelCode Then
                        subjectsScorePtr(j) = subjectsScorePtr(j) + _
                            optCode + minimums(i) - 1
                    End If
                End If
            Next i
        Next j
    End If
    
    ' create a new sheet
    WirtSerial = WirtSerial + 1
    Dim ws As Worksheet
    Set ws = Sheets.Add
    Dim wsName As String
wsNameCheck:
    wsName = ProgName & WirtSerial
    Dim ws2 As Worksheet
    For Each ws2 In Worksheets
        If ws2.name = wsName Then
            WirtSerial = WirtSerial + 1
            GoTo wsNameCheck
        End If
    Next
    ws.name = wsName
        
    ' remove the grid
    ws.Activate
    ActiveWindow.DisplayGridlines = False

    ' if a printer is available, define the footer
    On Error Resume Next
    ws.PageSetup.CenterHeader = Application.ActiveWorkbook.name
    ws.PageSetup.RightFooter = GText("printFooter")
    ws.PageSetup.LeftFooter = ProgName & " version " & Version
    ws.PageSetup.CenterHorizontally = True
    On Error GoTo errorEnd

    ' Copy the results
    Dim row As Integer
    Dim col As Integer
    row = 1
    col = 1
    ws.Columns.ColumnWidth = 14
    'ws.Columns(1).ColumnWidth = 20
    
    ' if SE
    Dim seStep As Integer
    If SE Then
        seStep = 1
    Else
        seStep = 0
    End If

    ' the CTT statistics
    If CTT Then
        WriteCell ws, row, col, GText("chkCTT"), , , , , True, , , 12
        WriteCell ws, row + 2, col, GText("cellNbrSubject"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col, NbrSubject, "0", xlHAlignCenter
        WriteCell ws, row + 2, col + 1, GText("cellNbrItem"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col + 1, NbrItem, "0", xlHAlignCenter
        WriteCell ws, row + 2, col + 2, GText("cellNbrMissing"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col + 2, NbrItem * NbrSubject - nbr, "0", xlHAlignCenter
        WriteCell ws, row + 2, col + 3, GText("cellMean"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col + 3, mean, "0.000", xlHAlignCenter
        WriteCell ws, row + 2, col + 4, GText("cellSd"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col + 4, sd, "0.000", xlHAlignCenter
        WriteCell ws, row + 2, col + 5, GText("cellAlpha"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row + 3, col + 5, alpha, "0.000", xlHAlignCenter
        row = row + 5
        WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, GText("cellItemMean"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 2, GText("cellItemSd"), , xlHAlignCenter, xlVAlignTop, True, , , True
        If PolyserialCorr = 0 Then
            WriteCell ws, row, col + 3, GText("cellItemCorr"), , xlHAlignCenter, xlVAlignTop, True, , , True
        Else
            WriteCell ws, row, col + 3, GText("chkPolyserialCorr"), , xlHAlignCenter, xlVAlignTop, True, , , True
        End If
        For i = 1 To NbrItem
            WriteCell ws, row + i, col, ItemLabels(i), , xlHAlignCenter, , , , True
            WriteCell ws, row + i, col + 1, itemsMeanPtr(i), "0.000", xlHAlignCenter
            WriteCell ws, row + i, col + 2, itemsSdPtr(i), "0.000", xlHAlignCenter
            If PolyserialCorr = 0 Then
                WriteCell ws, row + i, col + 3, itemsCorrPtr(i), "0.000", xlHAlignCenter
            Else
                WriteCell ws, row + i, col + 3, itemsPolyCorrPtr(i), "0.000", xlHAlignCenter
            End If
        Next i
        row = row + NbrItem + 2
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' correlation matrix
    If PairsCorr Then
        WriteCell ws, row, col, GText("chkPairsCorr"), , , , , True, , , 12
        row = row + 2
        WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 2, GText("cellCorr"), , xlHAlignCenter, xlVAlignTop, True, , , True
        row = row + 1
        For i = 1 To NbrItem - 1
            For j = i + 1 To NbrItem
                WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 1, ItemLabels(j), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 2, pairsCorrPtr((i - 1) * NbrItem + j), "0.000", xlHAlignCenter
                If pairsCorrPtr((i - 1) * NbrItem + j) >= 0.8 Or pairsCorrPtr((i - 1) * NbrItem + j) <= -0.1 Then
                    ws.Rows(row).Font.ColorIndex = 3
                End If
                row = row + 1
            Next j
        Next i
        row = row + 1
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' scores
    If Score Then
        WriteCell ws, row, col, GText("chkScore"), , , , , True, , , 12
        row = row + 2
        WriteCell ws, row, col, GText("cellSubject"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, GText("chkScore"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 2, GText("cellNbrItem"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 3, GText("cellSubject"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 4, GText("chkScore"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 5, GText("cellNbrItem"), , xlHAlignCenter, xlVAlignTop, True, , , True
        row = row + 1
        For j = 1 To Int(NbrSubject / 2) + (NbrSubject Mod 2)
            WriteCell ws, row, col, SubjectLabels(j), , xlHAlignCenter, , , , True
            WriteCell ws, row, col + 1, subjectsScorePtr(j), "0", xlHAlignCenter
            WriteCell ws, row, col + 2, subjectsNbrPtr(j), "0", xlHAlignCenter
            i = j + Int(NbrSubject / 2) + (NbrSubject Mod 2)
            If i <= NbrSubject Then
                WriteCell ws, row, col + 3, SubjectLabels(i), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 4, subjectsScorePtr(i), "0", xlHAlignCenter
                WriteCell ws, row, col + 5, subjectsNbrPtr(i), "0", xlHAlignCenter
            End If
            row = row + 1
        Next j
        row = row + 1
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' model info
    Dim strMethod As String
    If Penalized Then
        strMethod = GText("optPenalized")
    ElseIf Kernel Then
        strMethod = GText("optKernel")
    ElseIf Binary And (SlopePrior Or ThreshPrior Or (AsympPrior And model = 3)) Then
        strMethod = GText("cellBME")
    Else
        strMethod = GText("cellMMLE")
    End If
    Dim strModel As String
    If PLM1 Then strModel = GText("optPLM1")
    If PLM2 Then
        strModel = GText("optPLM2")
    End If
    If PLM3 Then strModel = GText("optPLM3")
    If NominalModel Then strModel = GText("optNominalModel")
    If GradedModel Then strModel = GText("optGradedModel")
    If Mixed Then strModel = GText("optMixed")
    If NormalOgive = 1 Then strModel = strModel + " (" + GText("chkNormalOgive") + ")"
    WriteCell ws, row, col, GText("cellModelInfo"), , , , , True, , , 12
    WriteCell ws, row + 2, col, GText("cellDataSource"), , , , True, , , True
    WriteCell ws, row + 2, col + 1, GText("cellRange", _
        RawData.Address, RawData.Worksheet.name, Application.ActiveWorkbook.name)
    WriteCell ws, row + 3, col, GText("cellMethod"), , , , True, , , True
    WriteCell ws, row + 3, col + 1, strMethod
    If Penalized Or Kernel Then
        WriteCell ws, row + 4, col, GText("cellSmoothPar"), , , , True, , , True
        WriteCell ws, row + 4, col + 1, smoothFactor
    Else
        WriteCell ws, row + 4, col, GText("cellModel"), , , , True, , , True
        WriteCell ws, row + 4, col + 1, strModel
    End If
    row = row + 5
    If Ability Then
         WriteCell ws, row, col, GText("lblAbilEstim"), , , , True, , , True
         WriteCell ws, row, col + 1, AbilEstim, , , , True, , , True
        row = row + 1
    End If
    WriteCell ws, row, col, GText("cellVersion"), , , , True, , , True
    WriteCell ws, row, col + 1, Version, , , , True, , , True
    row = row + 2
    
    ' list the ignored items
    If nbrIgnore = 0 Then
        WriteCell ws, row, col, GText("cellNoIgnore")
        row = row + 1
    Else
        WriteCell ws, row, col, GText("cellItemsIgnore", nbrIgnore)
        row = row + 1
        For i = 1 To NbrItem
            If ignorePtr(i) <> 0 Then
                WriteCell ws, row, col + 1, ItemLabels(i), , , , , , True
                row = row + 1
            End If
        Next i
    End If
    row = row + 1
    
    ' list the items that didn't converged
    If nbrNotConverge = 0 Then
        WriteCell ws, row, col, GText("cellNoNotConverge")
        row = row + 1
    Else
        WriteCell ws, row, col, GText("cellItemsNotConverge", nbrNotConverge)
        row = row + 1
        For i = 1 To NbrItem
            If notConvergePtr(i) <> 0 Then
                WriteCell ws, row, col + 1, ItemLabels(i), , , , , , True
                row = row + 1
            End If
        Next i
    End If
    row = row + 1
    ws.Rows(row).PageBreak = xlPageBreakManual

    ' test of fit
    If Fit Then
        WriteCell ws, row, col, GText("chkFit"), , , , , True, , , 12
        row = row + 2
        WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, GText("cellChiSqr"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 2, GText("cellDf"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 3, GText("cellPValue"), , xlHAlignCenter, xlVAlignTop, True, , , True
        row = row + 1
        For i = 1 To NbrItem
            WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
            WriteCell ws, row, col + 1, fitChi2Ptr(i), "0.000", xlHAlignCenter
            WriteCell ws, row, col + 2, fitDfPtr(i), "0", xlHAlignCenter
            WriteCell ws, row, col + 3, fitPValuePtr(i), "0.000", xlHAlignCenter
            If fitPValuePtr(i) <= 0.05 Then
                ws.Rows(row).Font.ColorIndex = 3
            End If
            row = row + 1
        Next i
        row = row + 1
        WriteCell ws, row, col, GText("cellTestGlobal"), , xlHAlignCenter, , , , True
        WriteCell ws, row, col + 1, fitChi2Ptr(NbrItem + 1), "0.000", xlHAlignCenter
        WriteCell ws, row, col + 2, fitDfPtr(NbrItem + 1), "0", xlHAlignCenter
        WriteCell ws, row, col + 3, fitPValuePtr(NbrItem + 1), "0.000", xlHAlignCenter
        If fitPValuePtr(i) <= 0.05 Then
            ws.Rows(row).Font.ColorIndex = 3
        End If
        row = row + 2
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' test of ld
    If LD Then
        WriteCell ws, row, col, GText("chkLD"), , , , , True, , , 12
        row = row + 2
        WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 2, GText("cellChiSqr"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 3, GText("cellDf"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 4, GText("cellPValue"), , xlHAlignCenter, xlVAlignTop, True, , , True
        row = row + 1
        For i = 1 To NbrItem - 1
            For j = i + 1 To NbrItem
                WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 1, ItemLabels(j), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 2, ldChi2Ptr((i - 1) * NbrItem + j), "0.000", xlHAlignCenter
                WriteCell ws, row, col + 3, ldDfPtr((i - 1) * NbrItem + j), "0", xlHAlignCenter
                WriteCell ws, row, col + 4, ldPValuePtr((i - 1) * NbrItem + j), "0.000", xlHAlignCenter
                If ldPValuePtr((i - 1) * NbrItem + j) <= 0.05 Then
                    ws.Rows(row).Font.ColorIndex = 3
                End If
                row = row + 1
            Next j
        Next i
        row = row + 1
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' items parameters
    If Parameter And Not Kernel And Not Penalized Then
        WriteCell ws, row, col, GText("chkParameter"), , , , , True, , , 12
        row = row + 2
        If Binary Then
            WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
            WriteCell ws, row, col + 1, GText("cellSlope"), , xlHAlignCenter, xlVAlignTop, True, , , True
            If SE Then WriteCell ws, row, col + 2, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
            WriteCell ws, row, col + 2 + seStep, GText("cellThresh"), , xlHAlignCenter, xlVAlignTop, True, , , True
            If SE Then WriteCell ws, row, col + 3 + seStep, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
            If model = 3 And Not SE Then
                WriteCell ws, row, col + 3 + seStep * 2, GText("cellAsymp"), , xlHAlignCenter, xlVAlignTop, True, , , True
                If SE Then WriteCell ws, row, col + 4 + seStep * 2, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
            End If
            row = row + 1
            For i = 1 To NbrItem
                WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 1, slopesPtr(i), "0.000", xlHAlignCenter
                If SE Then WriteCell ws, row, col + 2, slopesSdPtr(i), "0.000", xlHAlignCenter
                WriteCell ws, row, col + 2 + seStep, threshPtr(i), "0.000", xlHAlignCenter
                If SE Then WriteCell ws, row, col + 3 + seStep, threshSdPtr(i), "0.000", xlHAlignCenter
                If model = 3 And Not SE Then
                    WriteCell ws, row, col + 3 + seStep * 2, asympPtr(i), "0.000", xlHAlignCenter
                    If SE Then WriteCell ws, row, col + 4 + seStep * 2, asympSdPtr(i), "0.000", xlHAlignCenter
                End If
                row = row + 1
            Next i
            If model = 3 And SE Then
                row = row + 1
                WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
                WriteCell ws, row, col + 1, GText("cellAsymp"), , xlHAlignCenter, xlVAlignTop, True, , , True
                If SE Then WriteCell ws, row, col + 2, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
                row = row + 1
                For i = 1 To NbrItem
                    WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
                    WriteCell ws, row, col + 1, asympPtr(i), "0.000", xlHAlignCenter
                    If SE Then WriteCell ws, row, col + 2, asympSdPtr(i), "0.000", xlHAlignCenter
                    row = row + 1
                Next i
            End If
        Else
            WriteCell ws, row, col, GText("cellItem"), , xlHAlignCenter, xlVAlignTop, True
            WriteCell ws, row, col + 1, GText("cellOption"), , xlHAlignCenter, xlVAlignTop, True
            WriteCell ws, row, col + 2, GText("cellSlope"), , xlHAlignCenter, xlVAlignTop, True, , , True
            If SE Then WriteCell ws, row, col + 3, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
            WriteCell ws, row, col + 3 + seStep, GText("cellThresh"), , xlHAlignCenter, xlVAlignTop, True, , , True
            If SE Then WriteCell ws, row, col + 4 + seStep, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
            row = row + 1
            For i = 1 To NbrItem
                pos = itemsPosPtr(i)
                For o = 1 To nbrOptionsPtr(i)
                    WriteCell ws, row, col, ItemLabels(i), , xlHAlignCenter, , , , True
                    WriteCell ws, row, col + 1, OptionsNames(i).item(CStr(o)), , xlHAlignCenter, , , , True
                    WriteCell ws, row, col + 2, slopesPtr(pos + o), "0.000", xlHAlignCenter
                    If SE Then WriteCell ws, row, col + 3, slopesSdPtr(pos + o), "0.000", xlHAlignCenter
                    WriteCell ws, row, col + 3 + seStep, threshPtr(pos + o), "0.000", xlHAlignCenter
                    If SE Then WriteCell ws, row, col + 4 + seStep, threshSdPtr(pos + o), "0.000", xlHAlignCenter
                    If DataTypes(i) = NominalModelCode And OptionsNames(i).item(CStr(o)) = Key(i) Then
                        ws.Cells(row, col + 1).Font.Bold = True
                    End If
                    row = row + 1
                Next o
            Next i
        End If
        row = row + 1
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    ' subjects parameters
    If Ability Then
        WriteCell ws, row, col, GText("chkAbility"), , , , , True, , , 12
        row = row + 2
        WriteCell ws, row, col, GText("cellSubject"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 1, AbilName, , xlHAlignCenter, xlVAlignTop, True, , , True
        If SE Then WriteCell ws, row, col + 2, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
        WriteCell ws, row, col + 3, GText("cellSubject"), , xlHAlignCenter, xlVAlignTop, True
        WriteCell ws, row, col + 4, AbilName, , xlHAlignCenter, xlVAlignTop, True, , , True
        If SE Then WriteCell ws, row, col + 5, GText("cellSE"), , xlHAlignCenter, xlVAlignTop, True, , , True
        row = row + 1
        For j = 1 To Int(NbrSubject / 2) + (NbrSubject Mod 2)
            WriteCell ws, row, col, SubjectLabels(j), , xlHAlignCenter, , , , True
            WriteCell ws, row, col + 1, abilitiesPtr(j), "0.000", xlHAlignCenter
            If SE Then WriteCell ws, row, col + 2, abilitiesSdPtr(j), "0.000", xlHAlignCenter
            i = j + Int(NbrSubject / 2) + (NbrSubject Mod 2)
            If i <= NbrSubject Then
                WriteCell ws, row, col + 3, SubjectLabels(i), , xlHAlignCenter, , , , True
                WriteCell ws, row, col + 4, abilitiesPtr(i), "0.000", xlHAlignCenter
                If SE Then WriteCell ws, row, col + 5, abilitiesSdPtr(i), "0.000", xlHAlignCenter
            End If
            row = row + 1
        Next j
        row = row + 1
        ws.Rows(row).PageBreak = xlPageBreakManual
    End If
    
    Dim NbrPoint, step, nbrChart As Integer
    Dim quads() As Double
    Dim zseq() As Double
    Dim xTitle As String
    Dim iccs() As Double
    Dim yMaxAll As Double
    Dim yMinAll As Double
    If Curves Or Information Then
        If NbrQuad <= 32 Then
            NbrPoint = NbrQuad
            step = 1
        Else
            NbrPoint = 32
            step = NbrQuad / NbrPoint
        End If
        ReDim quads(NbrPoint) As Double
        ReDim zseq(NbrPoint) As Double
        ReDim testcc(NbrPoint) As Double
        For k = 1 To NbrPoint
            zseq(k) = Round(quadPointsPtr(k * step), 3)
            testcc(k) = 0
        Next k
        ReDim iccs(NbrItem, NbrPoint) As Double
        yMaxAll = 1
        yMinAll = 0
        For i = 1 To NbrItem
          If DataTypes(i) = GradedModelCode Then
                If yMaxAll < nbrOptionsPtr(i) + minimums(i) - 1 Then
                    yMaxAll = nbrOptionsPtr(i) + minimums(i) - 1
                End If
                If yMinAll > minimums(i) Then
                    yMinAll = minimums(i)
                End If
          End If
          For k = 1 To NbrPoint
            If Binary Then
                iccs(i, k) = Round(probsPtr((i - 1) * NbrQuad + k * step), 3)
            ElseIf DataTypes(i) = NominalModelCode Then
                iccs(i, k) = Round(iccPtr((i - 1) * NbrQuad + k * step), 3)
            ElseIf DataTypes(i) = GradedModelCode Then
                iccs(i, k) = Round(iccPtr((i - 1) * NbrQuad + k * step) + minimums(i) - 1, 3)
            End If
            testcc(k) = testcc(k) + iccs(i, k)
          Next k
        Next i
        If ScoreAbscisse Then
          xTitle = GText("chkScore")
          For k = 1 To NbrPoint
            quads(k) = testcc(k)
          Next k
        Else
          xTitle = AbilName
          For k = 1 To NbrPoint
            quads(k) = zseq(k)
          Next k
        End If
    End If
    
    ' ICC and OCC
    If Curves Then
        WriteCell ws, row, col, GText("chkCurves"), , , , , True, , , 12
        row = row + 2
        ' copy the curves (round them and use only 32 points)
        ' the quadratures
        nbrChart = 0
        Dim icc() As Double
        ReDim icc(NbrPoint) As Double
        Dim coICCS As ChartObject
        Dim coTCC As ChartObject
        Dim rowtcc As Integer
        For i = 1 To NbrItem
            ' the icc
            For k = 1 To NbrPoint
                icc(k) = iccs(i, k)
            Next k
            Dim co As ChartObject
            Dim yTitle As String
            Dim yTitleAll As String
            Dim yMax As Double
            Dim yMin As Double
            If DataTypes(i) = GradedModelCode Then
                yTitle = GText("axisGraded")
                yMax = nbrOptionsPtr(i) + minimums(i) - 1
                yMin = minimums(i)
            Else
                yTitle = GText("axisProb")
                yMax = 1
                yMin = 0
            End If
            ' all the iccs on the same chart
            If i = 1 Then
                ' save a space for the tcc
                rowtcc = row
                row = row + 26
                If Mixed Then
                    yTitleAll = GText("axisGraded")
                Else
                    yTitleAll = yTitle
                End If
                Set coICCS = makeChart(ws, row, col, quads, icc, , , _
                    ItemLabels(i), GText("titleICCS"), _
                    xTitle, yTitleAll, yMinAll, yMaxAll)
                row = row + 26
                ws.Rows(row).PageBreak = xlPageBreakManual
            Else
                addSerie coICCS, ItemLabels(i), quads, icc
            End If
            ' the tcc
            If i = NbrItem Then
                Set coTCC = makeChart(ws, rowtcc, col, zseq, testcc, , , _
                    GText("titleTCC"), GText("titleTCC"), _
                    AbilName, GText("chkScore"))
            End If
            ' one icc at a time
            Set co = makeChart(ws, row, col, quads, icc, , , , _
                GText("titleICC", ItemLabels(i)), _
                xTitle, yTitle, yMin, yMax)
            nbrChart = nbrChart + 1
            row = row + 26
            If nbrChart Mod 2 = 0 Then
                ws.Rows(row).PageBreak = xlPageBreakManual
            End If
                        
            ' the occs
            If Not Binary Then
                nbrOption = nbrOptionsPtr(i)
                pos = itemsPosPtr(i)
                For o = 1 To nbrOption
                    Dim occ() As Double
                    ReDim occ(NbrPoint) As Double
                    For k = 1 To NbrPoint
                        occ(k) = Round(probsPtr((pos + o - 1) * NbrQuad + k * step), 3)
                    Next k
                    If o = 1 Then
                        Set co = makeChart(ws, row, col, quads, occ, , , _
                            OptionsNames(i).item(CStr(o)), _
                            GText("titleOCC", ItemLabels(i)), xTitle, _
                            GText("axisProb"), 0, 1)
                        nbrChart = nbrChart + 1
                        row = row + 26
                        If nbrChart Mod 2 = 0 Then
                            ws.Rows(row).PageBreak = xlPageBreakManual
                        End If
                    Else
                        addSerie co, OptionsNames(i).item(CStr(o)), quads, occ
                    End If
                    If DataTypes(i) = NominalModelCode And OptionsNames(i).item(CStr(o)) = Key(i) Then
                        co.Chart.SeriesCollection(o).Border.Weight = 3
                        co.Chart.SeriesCollection(o).Border.LineStyle = xlDash
                    End If
                Next o
            End If
        Next i
        If nbrChart Mod 2 = 1 Then
            ws.Rows(row).PageBreak = xlPageBreakManual
        End If
    End If
    
    ' information functions
    If Information Then
        WriteCell ws, row, col, GText("chkInformation"), , , , , True, , , 12
        row = row + 2
        ' copy the curves (round them and use only 32 points)
        ' the quadratures
        nbrChart = 0
        Dim coAllInfo As ChartObject
        Dim info() As Double
        ReDim info(NbrPoint) As Double
        ' the test information function
        For k = 1 To NbrPoint
            info(k) = Round(testInfoPtr(k * step), 3)
        Next k
        Set coAllInfo = makeChart(ws, row, col, quads, info, 34, , , _
            GText("titleTestInfo"), xTitle, GText("axisInfo"))
        row = row + 36
        ws.Rows(row).PageBreak = xlPageBreakManual
        For i = 1 To NbrItem
            For k = 1 To NbrPoint
                info(k) = Round(infosPtr((i - 1) * NbrQuad + k * step), 3)
            Next k
            ' all the information function on the same chart
            If i = 1 Then
                Set coAllInfo = makeChart(ws, row, col, quads, info, 34, , _
                    ItemLabels(i), GText("titleAllInfo"), _
                    xTitle, GText("axisInfo"))
                row = row + 36
                ws.Rows(row).PageBreak = xlPageBreakManual
            Else
                addSerie coAllInfo, ItemLabels(i), quads, info
            End If
            ' one info function at a time
            Set co = makeChart(ws, row, col, quads, info, , , , _
                GText("titleInfo", ItemLabels(i)), _
                xTitle, GText("axisInfo"))
            row = row + 26
            If i Mod 2 = 0 Then
                ws.Rows(row).PageBreak = xlPageBreakManual
            End If
        Next i
    End If
    
    ' graphics' data points
    Dim firstItem, lastItem As Integer
    Dim nbrCol As Integer
    If DataPoints Then
        WriteCell ws, row, col, GText("chkDataPoints"), , , , , True, , , 12
        row = row + 2
        
        ' occ
        If Curves Then
            If Binary Then
                ' print 5 items at a time
                i = 1
                Do
                    WriteCell ws, row, col, xTitle, , xlHAlignCenter, _
                        xlVAlignTop, True, , , True
                    For k = 1 To NbrQuad
                        WriteCell ws, row + k, col, quadPointsPtr(k), "0.000", _
                        xlHAlignCenter
                    Next k
                    nbrCol = 1
                    Do While nbrCol <= 5 And i <= NbrItem
                        WriteCell ws, row, col + nbrCol, _
                            GText("titleICC", ItemLabels(i)), , _
                            xlHAlignCenter, xlVAlignTop, True, , , True
                        For k = 1 To NbrQuad
                            WriteCell ws, row + k, col + nbrCol, _
                                probsPtr((i + -1) * NbrQuad + k), _
                                "0.000", xlHAlignCenter
                        Next k
                        nbrCol = nbrCol + 1
                        i = i + 1
                    Loop
                    row = row + NbrQuad + 2
                    If i > NbrItem Then Exit Do
                Loop
            Else
                ' print 5 options at a time
                i = 1
                o = 1
                Do
                    WriteCell ws, row, col, xTitle, , xlHAlignCenter, _
                        xlVAlignTop, True, , , True
                    For k = 1 To NbrQuad
                        WriteCell ws, row + k, col, quadPointsPtr(k), "0.000", _
                        xlHAlignCenter
                    Next k
                    nbrCol = 1
                    Do While nbrCol <= 5 And i <= NbrItem
                        WriteCell ws, row, col + nbrCol, _
                            GText("cellOptionItem", OptionsNames(i).item(CStr(o)), ItemLabels(i)), , _
                            xlHAlignCenter, xlVAlignTop, True, , , True
                        For k = 1 To NbrQuad
                            WriteCell ws, row + k, col + nbrCol, _
                                probsPtr((itemsPosPtr(i) + o - 1) * NbrQuad + k), _
                                "0.000", xlHAlignCenter
                        Next k
                        nbrCol = nbrCol + 1
                        o = o + 1
                        If o > nbrOptionsPtr(i) Then
                            i = i + 1
                            o = 1
                        End If
                    Loop
                    row = row + NbrQuad + 2
                    If i > NbrItem Then Exit Do
                Loop
            End If
        End If
        
        ' info
        If Information Then
            ' print 5 items at a time
            i = 1
            Do
                WriteCell ws, row, col, xTitle, , xlHAlignCenter, _
                    xlVAlignTop, True, , , True
                For k = 1 To NbrQuad
                    WriteCell ws, row + k, col, quadPointsPtr(k), "0.000", _
                    xlHAlignCenter
                Next k
                nbrCol = 1
                Do While nbrCol <= 5 And i <= NbrItem
                    WriteCell ws, row, col + nbrCol, _
                        GText("cellInfo", ItemLabels(i)), , _
                        xlHAlignCenter, xlVAlignTop, True, , , True
                    For k = 1 To NbrQuad
                        WriteCell ws, row + k, col + nbrCol, _
                            infosPtr((i - 1) * NbrQuad + k), _
                            "0.000", xlHAlignCenter
                    Next k
                    nbrCol = nbrCol + 1
                    i = i + 1
                Loop
                row = row + NbrQuad + 2
                If i > NbrItem Then Exit Do
            Loop
        End If
    End If
    
normalEnd:
    
    Application.Calculation = calcState
    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
    
    Exit Sub
    
errorEnd:
    Application.Cursor = xlDefault
    Application.Calculation = calcState
    Application.ScreenUpdating = True
    MsgBox GText("msgError", Err.Description), vbCritical, ProgName

End Sub
