Crash na het tabblad selecteren EXCEL 2010

[harolda1980]

Als ik de onderstaande code uitvoer en ik daarna het tabblad ga bekijken crash excel 2010 elke keer. Heeft iemand een idee hoe dit kan=

Private Sub Make_rapport_Leveranciersoverzicht()
Dim rstLev As ADODB.Recordset
Dim rstfac As ADODB.Recordset
Dim rsttyp As ADODB.Recordset
Dim stringsql As String
Dim stringsql_sub1 As String
Dim stringsql_sub2 As String
Dim R As Long
Dim Tbrutosaldo As Currency
Dim Tnettosaldo As Currency
    Application.ScreenUpdating = False
    Set rstfac = New ADODB.Recordset
    Set rstLev = New ADODB.Recordset
    Set rsttyp = New ADODB.Recordset
    stringsql = "SELECT tblproject.idtblproject, sum(tblinregels.Netto) AS Offertebedrag, tblleverancier.leverancier FROM tblinregels INNER JOIN tblproject ON tblinregels.Kp_project = tblproject.idtblproject INNER JOIN  tblleverancier ON tblinregels.Kp_leverancier = tblleverancier.idtblleverancier WHERE tblproject.idtblproject =  " & ProjectIdentity & "  AND tblleverancier.leverancier <> 'Raming' GROUP BY tblleverancier.leverancier;"
    rstLev.Open stringsql, CNNAPP, adOpenForwardOnly, adLockReadOnly
    R = 14
    With Sheets("P")
        .Cells(4, 1).Value = "Locatie      : " & Fprojectnaam
        .Cells(5, 1).Value = "Projectnr  : " & Fprojectnr
        Do While Not rstLev.EOF
            .Cells(R, 1).Value = rstLev!leverancier
            .Cells(R, 4).Value = CDate(rstLev!Offertebedrag)
            stringsql_sub1 = "SELECT tblproject.idtblproject, tblleverancier.leverancier, sum(tblfact.Factuurbruto) AS Bruto, sum(tblfact.Factuurnetto) AS Netto FROM tblfact INNER JOIN tblleverancier ON tblfact.kp_leverancier = tblleverancier.idtblleverancier INNER JOIN tblproject ON tblfact.kp_project = tblproject.idtblproject WHERE tblproject.idtblproject = " & ProjectIdentity & " AND tblleverancier.leverancier = '" & rstLev!leverancier & "';"
            rstfac.Open stringsql_sub1, CNNAPP, adOpenForwardOnly, adLockReadOnly
            Do While Not rstfac.EOF
                .Cells(R, 6).Value = rstfac!Bruto
                .Cells(R, 7).Value = rstfac!Netto
                rstfac.MoveNext
            Loop
            rstfac.Close
            .Cells(R, 8).Value = CCur(Round(.Cells(R, 6).Value - .Cells(R, 7).Value, 2))
            .Cells(R, 10).Value = CCur(Round(.Cells(R, 4).Value - .Cells(R, 8).Value, 2))
            stringsql_sub2 = "SELECT tblproject.idtblproject, tblleverancier.leverancier, sum(tblfact.Factuurbruto) AS expr1, sum(tblfact.Factuurnetto) AS expr2, tblftype.Ftype FROM tblfact INNER JOIN tblleverancier ON tblfact.kp_leverancier = tblleverancier.idtblleverancier INNER JOIN tblproject ON tblfact.kp_project = tblproject.idtblproject INNER JOIN tblftype ON tblfact.Kp_ftype = tblftype.idtblftype WHERE tblproject.idtblproject = " & ProjectIdentity & " AND tblleverancier.leverancier = '" & rstLev!leverancier & "' GROUP BY tblftype.Ftype, tblleverancier.leverancier ;"
            rsttyp.Open stringsql_sub2, CNNAPP, adOpenForwardOnly, adLockReadOnly
            Do While Not rsttyp.EOF
                If rsttyp!Ftype = "kosten" Then .Cells(R, 13).Value = rsttyp!expr1 - rsttyp!expr2
                If rsttyp!Ftype = "Investering" Then .Cells(R, 14).Value = rsttyp!expr1 - rsttyp!expr2

                rsttyp.MoveNext
            Loop
            rsttyp.Close
            rstLev.MoveNext
            R = R + 1
        Loop
        rstLev.Close
        Set rstLev = Nothing
        Set rstfac = Nothing
        Set rsttyp = Nothing
        .PrintOut
    End With
    Application.ScreenUpdating = True
End Sub