生成excel报表的问题！急！

Question

我对已经查询出的结果生成excel报表，该窗体里有两个按纽，即对查询出的结果生成a和b两类不同的报表。可当我任意按其中一个command键生成了一个报表，要想生成另外一个报表，于是系统报错，提示为“对象‘range’的方法_Global失败”，这是什么意思？

Answer 1

因为比较长，我分别分几次粘贴
 Public Sub makeexcelusers(ByVal rs As ADODB.Recordset, ByVal savepath As String)  Dim ex1   As New Excel.Application
  Dim exBook1   As New Excel.Workbook
  Dim exsheet1   As New Excel.Worksheet
  Dim irow, icol As Integer
  
  Set exBook1 = ex1.Workbooks().Add
  Set exsheet1 = exBook1.Worksheets("sheet1")
  
    Range("a:a").Select
       Selection.ColumnWidth = 37
    Range("b:b").Select
       Selection.ColumnWidth = 17
    Range("c:c").Select
       Selection.ColumnWidth = 15
    Range("d:d").Select
       Selection.ColumnWidth = 8
    Range("e:e").Select
       Selection.ColumnWidth = 8
    Range("f:f").Select
       Selection.ColumnWidth = 8
    Range("g:g").Select
       Selection.ColumnWidth = 18
    Range("h:h").Select
       Selection.ColumnWidth = 13
    Range("i:i").Select
       Selection.ColumnWidth = 10
    Range("j:j").Select
       Selection.ColumnWidth = 16
    Range("k:k").Select
       Selection.ColumnWidth = 7
    Range("l:l").Select
       Selection.ColumnWidth = 10
    Range("a2:l50").Select
       Selection.RowHeight = 25
    Range("a1:l50").Select
       Selection.RowHeight = 50
    Range("a2:l2").Select
       Selection.RowHeight = 20
    Range("a1:l1").Select
    Selection.Merge
    Range("a1:l1").Value = "管 线 所 新 增 用 户 报 表"
    Range("a1:l1").Select
        With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
        End With
        Selection.Font.Bold = True
        With Selection.Font
                .Name = "楷体_GB2312"
                .Size = 30
        End With
    Range("a2:l2").Select
      Selection.Merge
      Range("a2:l2").Value = "     年    月   日"
    Range("a2:l2").Select
        With Selection
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
        End With
        Selection.Font.Bold = True
        With Selection.Font
                .Name = "仿宋_GB2312"
                .Size = 20
        End With
  
  If rs.BOF And rs.EOF Then Exit Sub
   
   irow = 3
   icol = 0
   For icol = 0 To 11
        exsheet1.Cells(3, icol + 1) = rs.Fields(icol).Name
   Next
   
   
   rs.MoveFirst
   MsgBox rs.RecordCount
    proexcel.Value = 0
    proexcel.Max = rs.RecordCount
    While Not rs.EOF
        irow = irow + 1
        For icol = 0 To 11
            exsheet1.Cells(irow, icol + 1) = rs.Fields(icol).Value
        Next
        proexcel.Value = proexcel.Value + 1
        rs.MoveNext
    Wend
  
  Range("a3:l100").Select
        With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
        End With
Range("a1:l100").Select
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
    End With
    With Selection.Font
                .Name = "宋体"
                .Size = 14
    End With
    
ActiveWorkbook.SaveAs FileName:="d:\肖锦姗\程序\维护\用户.xls"
        exBook1.Close
    ex1.Quit
    Set ex1 = Nothing
    Set exBook1 = Nothing
    Set exsheet1 = Nothing
End Sub

Answer 2

Private Sub makeexcelpipe(ByVal rs As ADODB.Recordset, ByVal savepath As String)  Dim ex1   As New Excel.Application
  Dim exBook1   As New Excel.Workbook
  Dim exsheet1   As New Excel.Worksheet
  Dim irow, icol As Integer
  
  Set exBook1 = ex1.Workbooks().Add
  Set exsheet1 = exBook1.Worksheets("sheet1")
  
    Range("a:a").Select
       Selection.ColumnWidth = 50
    Range("b:b").Select
       Selection.ColumnWidth = 20
    Range("c:c").Select
       Selection.ColumnWidth = 15
    Range("d:d").Select
       Selection.ColumnWidth = 10
    Range("e:e").Select
       Selection.ColumnWidth = 10
    Range("f:f").Select
       Selection.ColumnWidth = 10
    Range("g:g").Select
       Selection.ColumnWidth = 18
    Range("h:h").Select
       Selection.ColumnWidth = 11
    Range("i:i").Select
       Selection.ColumnWidth = 16
    Range("j:j").Select
       Selection.ColumnWidth = 9.38
    Range("a2:k100").Select
       Selection.RowHeight = 40
    Range("a2:k2").Select
       Selection.RowHeight = 20
    Range("a1:k1").Select
    Selection.Merge
    Range("a1:k1").Value = "管 线 所 新 增 干 管 报 表"
    Range("a1:k1").Select
        With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
        End With
        Selection.Font.Bold = True
        With Selection.Font
                .Name = "楷体_GB2312"
                .Size = 30
        End With
    Range("a2:k2").Select
      Selection.Merge
      Range("a2:l2").Value = "     年    月   日"
    Range("a2:k2").Select
        With Selection
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
        End With
        Selection.Font.Bold = True
        With Selection.Font
                .Name = "仿宋_GB2312"
                .Size = 20
        End With
  
  If rs.BOF And rs.EOF Then Exit Sub
   
   irow = 3
   icol = 0
   For icol = 0 To 9
        exsheet1.Cells(3, icol + 1) = rs.Fields(icol).Name
   Next
   
    rs.MoveFirst
    MsgBox rs.RecordCount
    While Not rs.EOF
        irow = irow + 1
        For icol = 0 To 9
            exsheet1.Cells(irow, icol + 1) = rs.Fields(icol).Value
        Next
       ' proexcel.Value = proexcel.Value + 1
        rs.MoveNext
    Wend
  
  Range("a3:k100").Select
        With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
        End With
Range("a1:k100").Select
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
    End With
ActiveWorkbook.SaveAs FileName:="d:\程序\维护\干管.xls"
   
    exBook1.Close
    ex1.Quit
    Set ex1 = Nothing
    Set exBook1 = Nothing
    Set exsheet1 = Nothing
End SubPublic Sub makeexceltotal(ByVal rs As ADODB.Recordset, ByVal savepath As String)  Dim ex   As New Excel.Application
  Dim exBook   As New Excel.Workbook
  Dim exsheet   As New Excel.Worksheet
  Dim irow, icol As Integer
  
  'Set ex = CreateObject("Excel.Application")
  'Set exBook = ex.Workbooks.Open("C:\my documents\a.xls")
  Set exBook = ex.Workbooks().Add
  Set exsheet = exBook.Worksheets("sheet1")
  
    Range("a1:q1").Select
    Selection.Merge
    Range("a1:q1").Select
        With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
        End With
        Selection.Font.Bold = True
        With Selection.Font
                .Name = "黑体"
                .Size = 22
        End With
  
  If rs.BOF And rs.EOF Then Exit Sub
   
   irow = 2
   icol = 0
   For icol = 0 To 17
        exsheet.Cells(2, icol + 1) = rs.Fields(icol).Name
   Next
   
   rs.MoveFirst
    
    While Not rs.EOF
        irow = irow + 1
        For icol = 0 To 17
            exsheet.Cells(irow, icol + 1) = rs.Fields(icol).Value
        Next
        rs.MoveNext
    Wend
    
ActiveWorkbook.SaveAs FileName:="d:\程序\维护\1.xls"
    
    exBook.Close
    ex.Quit
    Set ex = Nothing
    Set exBook = Nothing
    Set exsheet = Nothing
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
List1.Visible = False
End SubPrivate Sub table(ss As String)
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Select Case List1.ListIndex
    Case 0
    conn.Open ("dsn=pb")
    rs.CursorLocation = adUseClient
    rs.Open "select 工程名称 as 用气单位 ,工程地址 as 用气地点 ,管径,长度,压力,交接日期 as 日期 ,调压设备型号,接管地点,接管管径,气源点,户数,备注 from pipe where 1=1 " & Trim(ss) & " and 管径<>'' and (用户类型='庭院'or 用户类型='调压箱') order by 工程名称", conn, , , adCmdText
    
    makeexcelusers rs, "\\管线科4\D:\我的文件夹\报表底稿" & "\报表表格.xls"
    
    Set rs = Nothing
    Set conn = Nothing
    MsgBox "   报表已生成"
    
   Case 1
     conn.Open ("dsn=pb")
    rs.Open "select 工程名称 as 干管名称 ,工程地址 as 用气地点 ,管径,长度,压力,交接日期 as 日期,接管地点,接管管径,气源点,备注 from pipe where 1=1 " & Trim(ss) & " and 管径<>'' and (用户类型='区干管'or 用户类型='主干管')  order by 工程名称", conn, , , adCmdText
    MsgBox rs.RecordCount
    makeexcelpipe rs, "\\管线科4\D:\秦薇的文件夹\报表底稿" & "\干管报表表格.xls"    Set rs = Nothing
    Set conn = Nothing
    MsgBox "   报表已生成"   Case 2
    conn.Open ("dsn=pb")
    Set rs = conn.Execute("select * from pipe where 1=1 " & Trim(ss))    makeexceltotal rs, "\\管线科4\d:\程序\维护 " & "\1.xls"    Set rs = Nothing
    Set conn = Nothing
    MsgBox "   报表已生成"
  End Select
End Sub

Answer 3

就是从第一个range开始报错，提示为“对象‘range’的方法_Global失败”，这是什么意思？

Answer 4

请先记住一句话：VB操作OFFICE程序时，所有语句都要以定义好的对象开始！把 Range("a:a").Select
       Selection.ColumnWidth = 37
改成
with exsheet1
   .Range("a:a").ColumnWidth = 37  'Select与Selection可以省去
   ........出错是因为EXCEL对象没有释放，并且由于没有用定义好的对象限定，第二次运行时，程序继续对原来EXCEL对象进行操作，由于原来对象中的表中单元格有的已被合并，对单元格的某些操不能再进行了。

Answer 5

大头老兄，因为这段急于忙其它一些工作，所以没来得及复帖！我象你所说的那样修改了，可还是不行，程序还是报同样的错误“对象‘range’的方法_Global失败”，怎么回事啊？