当前位置:编程学习 > VB >>

求助:用VB把数据导EXCEL中问题,(实时错误 '1004' 对象 'Range' 的方法 '_Global' 失败)

用VB把数据导入EXCEL问题,(实时错误 '1004' 对象 'Range' 的方法 '_Global' 失败)学习别人的代码遇到的问题代码如下:
Private Sub Command1_Click()

  Dim iRow, iCol, iRowCount, iColCount As Integer
  Dim sSource, sDestination, sRange As String
  Dim ExcelApp As Excel.Application
  Dim ExcelBook As Excel.Workbook
  Dim ExcelSheet As Excel.Worksheet
 
  sSource = App.Path & "\缴费表打印模板.xls"
  sDestination = App.Path & "\temp.xls"
  
 FileCopy sSource, sDestination
  '将模板文件拷贝到一个临时文件
  Set ExcelApp = CreateObject("Excel.Application")
  ExcelApp.Visible = False
  '隐藏Excel应用程序窗口
  ExcelApp.Caption = "缴费情况表打印"
  Set ExcelBook = ExcelApp.Workbooks.Open(sDestination)
  Set ExcelSheet = ExcelBook.Worksheets(1)
  With Adodc1.Recordset
      .MoveLast
      If .RecordCount < 1 Then
          MsgBox ("Error 没有记录!")
          Exit Sub
      End If
      iRowCount = .RecordCount '记录总数
      iColCount = .Fields.Count '字段总数
      If iRowCount > 2 Then
          ExcelSheet.Range("A6").Select
          For iRow = iRowCount To 3 Step -1 '递减循环,step步长-1
          '模板中已有两行
          ExcelApp.Selection.EntireRow.Insert
          Next
          sRange = "E5:E" & LTrim(Str(iRowCount + 4))
          ExcelSheet.Range("E5").Select
          Selection.AutoFill Destination:=Range(sRange), Type:=x1FillDefault          
          sRange = "F5:F" & LTrim(Str(iRowCount + 4))
          ExcelSheet.Range("F5").Select
          Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault
          
          sRange = "G5:G" & LTrim(Str(iRowCount + 4))
          ExcelSheet.Range("G5").Select
          Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault
          
      End If
      .MoveFirst
      For iRow = 1 To iRowCount
        For iCol = 1 To iColCount
          ExcelSheet.Cells(iRow + 4, iCol).Value = .Fields(iCol - 1)
        Next
        If Not .EOF Then .MoveNext
      Next
  End With

ExcelApp.Visible = True

Set ExcelSheet = Nothing
Set ExcelBook = Nothing
Set ExcelApp = Nothing
 MsgBox ("导出成功!")
End Sub
第一次运行时一切正常,但按CTRL+ALT+DEL,仍可在关闭程序窗口看见EXCEL,
第二次运行时出现:实时错误 '1004' 对象 'Range' 的方法 '_Global' 失败 
调试时提示程序中红色语句有问题
该如何解决?谢谢。
--------------------编程问答-------------------- 加New
  Dim ExcelApp As New Excel.Application
  Dim ExcelBook As New Excel.Workbook
  Dim ExcelSheet As New Excel.Worksheet
--------------------编程问答-------------------- 我试了下,还是不行!是不是还有别的地方需要修改呀??急!! --------------------编程问答-------------------- 把发红那行去掉试试 --------------------编程问答--------------------  虽然可以多次单击,但是E5,F5,G5单元格的公式不能被复制到以后的单元格里了 --------------------编程问答--------------------
Private Sub Command1_Click()
Dim ExcelApp As New Excel.Application
  Dim ExcelBook As New Excel.Workbook
  Dim ExcelSheet As New Excel.Worksheet


  Dim iRow, iCol, iRowCount, iColCount As Integer
  Dim sSource, sDestination, sRange As String
  Dim ExcelApp As Excel.Application
  Dim ExcelBook As Excel.Workbook
  Dim ExcelSheet As Excel.Worksheet
  
  sSource = App.Path & "\缴费表打印模板.xls"
  sDestination = App.Path & "\temp.xls"
   
 FileCopy sSource, sDestination
  '将模板文件拷贝到一个临时文件
  Set ExcelApp = CreateObject("Excel.Application")
  ExcelApp.Visible = False
  '隐藏Excel应用程序窗口
  ExcelApp.Caption = "缴费情况表打印"
  Set ExcelBook = ExcelApp.Workbooks.Open(sDestination)
  Set ExcelSheet = ExcelBook.Worksheets(1)
  With Adodc1.Recordset
  .MoveLast
  If .RecordCount < 1 Then
  MsgBox ("Error 没有记录!")
  Exit Sub
  End If
  iRowCount = .RecordCount '记录总数
  iColCount = .Fields.Count '字段总数
  If iRowCount > 2 Then
  ExcelSheet.Range("A6").Select
  For iRow = iRowCount To 3 Step -1 '递减循环,step步长-1
  '模板中已有两行
  ExcelApp.Selection.EntireRow.Insert
  Next
  sRange = "E5:E" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("E5").Select
  ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=x1FillDefault
  sRange = "F5:F" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("F5").Select
  ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault
     
  sRange = "G5:G" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("G5").Select
 ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault

  End If
  .MoveFirst
  For iRow = 1 To iRowCount
  For iCol = 1 To iColCount
  ExcelSheet.Cells(iRow + 4, iCol).Value = .Fields(iCol - 1)
  Next
  If Not .EOF Then .MoveNext
  Next
  End With

ExcelApp.Visible = True

Set ExcelSheet = Nothing
Set ExcelBook = Nothing
Set ExcelApp = Nothing
 MsgBox ("导出成功!")
End Sub
--------------------编程问答--------------------
Private Sub Command1_Click()
  Dim iRow, iCol, iRowCount, iColCount As Integer
  Dim sSource, sDestination, sRange As String
  Dim ExcelApp As Excel.Application
  Dim ExcelBook As Excel.Workbook
  Dim ExcelSheet As Excel.Worksheet
  
  sSource = App.Path & "\缴费表打印模板.xls"
  sDestination = App.Path & "\temp.xls"
   
 FileCopy sSource, sDestination
  '将模板文件拷贝到一个临时文件
  Set ExcelApp = CreateObject("Excel.Application")
  ExcelApp.Visible = False
  '隐藏Excel应用程序窗口
  ExcelApp.Caption = "缴费情况表打印"
  Set ExcelBook = ExcelApp.Workbooks.Open(sDestination)
  Set ExcelSheet = ExcelBook.Worksheets(1)
  With Adodc1.Recordset
  .MoveLast
  If .RecordCount < 1 Then
  MsgBox ("Error 没有记录!")
  Exit Sub
  End If
  iRowCount = .RecordCount '记录总数
  iColCount = .Fields.Count '字段总数
  If iRowCount > 2 Then
  ExcelSheet.Range("A6").Select
  For iRow = iRowCount To 3 Step -1 '递减循环,step步长-1
  '模板中已有两行
  ExcelApp.Selection.EntireRow.Insert
  Next
  sRange = "E5:E" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("E5").Select
  ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=x1FillDefault
  sRange = "F5:F" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("F5").Select
  ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault
     
  sRange = "G5:G" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("G5").Select
 ExcelApp.Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault

  End If
  .MoveFirst
  For iRow = 1 To iRowCount
  For iCol = 1 To iColCount
  ExcelSheet.Cells(iRow + 4, iCol).Value = .Fields(iCol - 1)
  Next
  If Not .EOF Then .MoveNext
  Next
  End With

ExcelApp.Visible = True

Set ExcelSheet = Nothing
Set ExcelBook = Nothing
Set ExcelApp = Nothing
 MsgBox ("导出成功!")
End Sub
--------------------编程问答-------------------- 建议用在EXCEL里使用宏录制自己制作代码,挺方便的 --------------------编程问答-------------------- 谢谢6楼,我试了下,还会报同样的错误!
7楼可否说的详细些 呵呵 我不是很清楚 谢谢  --------------------编程问答--------------------  还是那行吗? --------------------编程问答-------------------- 是的 还是那行报错!不知道怎么回事? --------------------编程问答-------------------- Selection.AutoFill Destination:=ExcelSheet.Range(sRange), Type:=x1FillDefault    --------------------编程问答--------------------  ExcelSheet.Range("E5").AutoFill ... --------------------编程问答--------------------   
  .....
  ExcelBook.sheets(1).Activate '加这句激活一下就行,工作表1或2,自己根据实际而定,或输入 表名
  ExcelSheet.Range("A6").Select
  For iRow = iRowCount To 3 Step -1 '递减循环,step步长-1
  '模板中已有两行
  ExcelApp.Selection.EntireRow.Insert
  Next
  sRange = "E5:E" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("E5").Select
  Selection.AutoFill Destination:=Range(sRange), Type:=x1FillDefault 
 
  ....... 
--------------------编程问答-------------------- 我又试了下 还是不行呀!唉。。。。。 --------------------编程问答-------------------- 原来是一点都不会,全靠让别人给你调试好啊?我看还是死心吧
平时不努力,毕设干着急。 --------------------编程问答-------------------- 呵呵 我是半路出家  毕设? 好像离我已经很远了! --------------------编程问答-------------------- Selection.AutoFill Destination:=Range(sRange), Type:=xlFillDefault

你这个range是哪个sheet里面的?


Selection.AutoFill Destination:=ExcelSheet.Range(sRange), Type:=xlFillDefault
这样试试看 --------------------编程问答-------------------- sRange x1FillDefault 这两个常量赋一下值试试,具体值网上查一下 --------------------编程问答-------------------- sRange = "E5:E" & LTrim(Str(iRowCount + 4))
  ExcelSheet.Range("E5").Select
  Selection.AutoFill Destination:=Range(sRange), Type:=x1FillDefault   
********************

try


ExcelSheet.Range("E5").AutoFill Destination:=Range(sRange), Type:=x1FillDefault    --------------------编程问答-------------------- li163 有效,顶~~~~~~~~~~~~~ --------------------编程问答-------------------- --------------------编程问答-------------------- 你可以设置切换断点调试,看看问题具体出现在哪个位置
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,