大头老兄,因为这段急于忙其它一些工作,所以没来得及复帖!我象你所说的那样修改了,可还是不行,程序还是报同样的错误“对象‘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
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
解决方案 »
- access里显示数据的是什么表格控件?
- 关于将数据库导出到EXCEL的问题
- 关于Tapstrip 控件上添加其它控件使用的请教!
- 如何实现气泡式提示(不是mousemove)?
- 软件安装,都是那些下一步。。。。,可以自己定制界面吗?
- 水晶报表问题,大虾们救救小女子!150分,很急
- 请问如何用ESC键,关闭窗体啊!谢谢! 在线等待!.....
- 怎样保存文本框中的内容,以便再次开机时能使用文本框中的内容
- 一个大难题!!!
- jjjwltcs(叶子)有个小问题。。。。。。。。。。。。。
- 哪个API是可以判断出某个exe(例如word.exe)是否处于运行状态?
- 有没有API函数可以获得ini文件中的所有项目名?
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
exsheet1.Range
改成
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"
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放在哪里呢?请指教
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