access 打印到ＥＸＣＥＬ中出错

急，急，急，求教　：access数据打印到excel 因数据量较大，在输出ＥＸＣＥＬ过程中，在ＥＸＣＥＬ中用鼠标滚轮一转动，ＶＢＡ就报出错，请问有何办法解决。

具体代码如
  Dim xlapp As New Excel.Application
  Dim xLbook As Excel.Workbook
  Set xLbook = xlapp.Workbooks.Open(CurrentProject.Path & "\报表模板\4自然人一般农户贷款分类工作底稿(4.1-4.4表)(附件4).xlt")
  
  Dim XLsheet As Excel.Worksheet
  
   Set XLsheet = xLbook.Worksheets("文本首页")
  xlapp.Visible = True
 
 XLsheet.Cells(30, 5) = 大额列表.Column(2)
 
   XLsheet.Cells(31, 1) = Format(日期, "yyyy年mm月")
  
  
 XLsheet.Cells(33, 5) = 单位
 
 
 Set XLsheet = xLbook.Worksheets("分类认定")

 
    XLsheet.Cells(4, 1) = "填报单位:" & 单位
    XLsheet.Cells(4, 8) = Format(日期, "yyyy 年 mm月")
   
  
 
  sql = "select * from 户名表 where 类型='自然人（小）' order by 五级形态,借款人名称"
 
 
  Dim rs As New ADODB.Recordset
  Dim rs1 As New ADODB.Recordset
  Dim 序号 As Integer
  序号 = 0
  rs.Open sql, CurrentProject.Connection, 1, 1
  If rs.RecordCount <= 0 Then
      MsgBox "无数据"
      Exit Sub
  End If
  For i = 0 To rs.RecordCount - 1
 
 
    sql1 = "select * from 机构贷款明细表 where 客户号='" & Nz(rs("客户号")) & "' or 第二客户号='" & Nz(rs("客户号")) & "'"
 
    
     rs1.Open sql1, CurrentProject.Connection, 1, 1
 
   
   
    If rs1.RecordCount > 0 Then
   
  
    For t = 0 To rs1.RecordCount - 1
     序号 = Nz(序号) + 1
   XLsheet.Cells(6 + 序号, 1) = 序号
   XLsheet.Cells(6 + 序号, 2) = Nz(rs("借款人名称"))
   XLsheet.Cells(6 + 序号, 3) = Nz(rs1("担保方式")) '贷款方式
   XLsheet.Cells(6 + 序号, 4) = Round(Nz(rs1("贷款余额")) / 10000, 2)
   XLsheet.Cells(6 + 序号, 5) = Format(Nz(rs1("贷款发放日期")), "yyyy-mm-dd")
   XLsheet.Cells(6 + 序号, 6) = Format(Nz(rs1("到期日期")), "yyyy-mm-dd")
  
  
   If DateDiff("d", 日期, Nz(rs1("到期日期"))) >= 0 Then
      XLsheet.Cells(6 + 序号, 7) = Null
    XLsheet.Cells(6 + 序号, 9) = "良好"

   
   Else
    XLsheet.Cells(6 + 序号, 7) = DateDiff("d", Nz(rs1("到期日期")), 日期) '逾期天数
   XLsheet.Cells(6 + 序号, 9) = "一般"
 End If
   ''''****************填写贷款类别
  
  
   If Nz(rs("五级形态")) = "正常" Then
  
   XLsheet.Cells(6 + 序号, 10) = "√"
   XLsheet.Cells(6 + 序号, 11) = ""
   XLsheet.Cells(6 + 序号, 12) = ""
   XLsheet.Cells(6 + 序号, 13) = ""
   XLsheet.Cells(6 + 序号, 14) = ""
  
   ElseIf Nz(rs("五级形态")) = "关注" Then
  
   XLsheet.Cells(6 + 序号, 10) = ""
   XLsheet.Cells(6 + 序号, 11) = "√"
   XLsheet.Cells(6 + 序号, 12) = ""
   XLsheet.Cells(6 + 序号, 13) = ""
   XLsheet.Cells(6 + 序号, 14) = ""
  
   ElseIf Nz(rs("五级形态")) = "次级" Then
  
   XLsheet.Cells(6 + 序号, 10) = ""
   XLsheet.Cells(6 + 序号, 11) = ""
   XLsheet.Cells(6 + 序号, 12) = "√"
   XLsheet.Cells(6 + 序号, 13) = ""
   XLsheet.Cells(6 + 序号, 14) = ""
  
   ElseIf Nz(rs("五级形态")) = "可疑" Then
  
   XLsheet.Cells(6 + 序号, 10) = ""
   XLsheet.Cells(6 + 序号, 11) = ""
   XLsheet.Cells(6 + 序号, 12) = ""
   XLsheet.Cells(6 + 序号, 13) = "√"
   XLsheet.Cells(6 + 序号, 14) = ""
  
  
   ElseIf Nz(rs("五级形态")) = "损失" Then
  
   XLsheet.Cells(6 + 序号, 10) = ""
   XLsheet.Cells(6 + 序号, 11) = ""
   XLsheet.Cells(6 + 序号, 12) = ""
   XLsheet.Cells(6 + 序号, 13) = ""
   XLsheet.Cells(6 + 序号, 14) = "√"
   Else
  
   XLsheet.Cells(6 + 序号, 10) = ""
   XLsheet.Cells(6 + 序号, 11) = ""
   XLsheet.Cells(6 + 序号, 12) = ""
   XLsheet.Cells(6 + 序号, 13) = ""
   XLsheet.Cells(6 + 序号, 14) = ""
 
  
   End If
  
  
   '**********分类理由
  ' XLsheet.Cells(6 + 序号, 15) = Nz(rs("分类理由"))
    'XLsheet.Cells(6 + 序号, 16) = 操作员
  
   rs1.MoveNext
   Next t
  
   
   End If
  
   rs1.Close
  
   rs.MoveNext
   Next i
  
   rs.Close
  
   下：

点击下载此附件