大头老兄,因为这段急于忙其它一些工作,所以没来得及复帖!我象你所说的那样修改了,可还是不行,程序还是报同样的错误“对象‘range’的方法_Global失败”,怎么回事啊?我现在还是把代码贴在下面
 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

解决方案 »

  1.   

    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
      

  2.   

    在Range前加上你的Sheet對象:
    exsheet1.Range
      

  3.   

    先请理解一下原则:    所有操控EXCEL的语句都要以定义好的对象变量开始!由于代码太多,以下是示例如:Range("a2:l2").Value = "     年    月   日"
    改成
    exsheet1.Range("a2:l2").Value = "     年    月   日"select与selection可以合并如    Range("a:a").Select
           Selection.ColumnWidth = 37
    可以是
        Range("a:a").ColumnWidth = 37如:    Range("a1:l1").Select
        Selection.Merge
    可以是    Range("a1:l1").Merge如    Range("a2:l2").Select
            With Selection
    可以是:With Range("a2:l2")如果一定要用selection,则要改成ex1.Selection如:ActiveWorkbook.SaveAs FileName:="d:\肖锦姗\程序\维护\用户.xls"
    改成:exBook1.SaveAs FileName:="d:\肖锦姗\程序\维护\用户.xls"
      

  4.   

    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
     这段代码该怎么修改呢?我试了一下,都不行,应该把exsheet1放在哪里呢?请指教
      

  5.   


        With exsheet1.PageSetup
            .LeftMargin = ex1.InchesToPoints(0.75)
            .RightMargin = ex1.InchesToPoints(0.75)
            .TopMargin = ex1.InchesToPoints(1)
            .BottomMargin = ex1.InchesToPoints(1)
            .HeaderMargin = ex1.InchesToPoints(0.5)
            .FooterMargin = ex1.InchesToPoints(0.5)
            .Orientation = xlLandscape
            .PaperSize = xlPaperA3
        End With
        With Range("a1:l100").Font
                    .Name = "宋体"
                    .Size = 14
        End With