1.现在W7电脑打开报错
2.XP电脑导出EXCEL合计不居中显示
1.求老师帮忙看看框起来的是什么意思，我标注的是否正确？
On Error GoTo err
Dim strSQL1, strSQL2 As String
Dim rst1, rst2 As Object
Dim strid As String
Dim objxls As Object
Dim lngNumber, N, L As Long
strSQL1 = "SELECT 表1.区公司 FROM 表1 GROUP BY 表1.区公司;"
Set rst1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
rst1.MoveFirst
Do Until rst1.EOF
strid = rst1!区公司 '循环读取分组字段的值
' MsgBox strid
strSQL2 = "SELECT 表1.区公司, 表1.月份, 表1.业务量, 表1.流转额 FROM 表1 where 区公司='" & strid & "'"
Set rst2 = CurrentDb.OpenRecordset(strSQL2, dbOpenDynaset)
If rst2.RecordCount > 0 Then
'如有数据则将游标指针移到最后一条记录
rst2.MoveLast
'获取记录集中的记录数
lngNumber = rst2.RecordCount
End If
Set objxls = CreateObject("excel.Application")
objxls.Workbooks.Add
With objxls.Sheets("Sheet1")
'-----------------------------------------------------------表头数据
.Range("A1") = strid & "结算明细表"
.Range("A2") = "区公司"
.Range("b2") = "月份"
.Range("c2") = "业务量"
.Range("d2") = "流转额"
N = 3
L = N + lngNumber
'------------------------------------------------------------表格数据
rst2.MoveFirst
Do While Not rst2.EOF
.Range("A" & N) = rst2("区公司")
.Range("B" & N) = rst2("月份")
.Range("C" & N) = rst2("业务量")
.Range("D" & N) = rst2("流转额")
rst2.MoveNext
N = N + 1
Loop
'------------------------------------------------------------表尾数据
.Range("A" & L) = "合计"
.Range("D" & L) = DSum("流转额", "表1", "区公司='" & strid & "'")
.Range("A" & L + 1) = "制表单位："
.Range("C" & L + 1) = "制表日期："
.Range("D" & L + 1) = Date
.Range("D" & L + 1).NumberFormatLocal = "yyyy-m-d" '显示格式
'-------------------------------------------------------------设置格式
With .Range("A2:D10")
.ColumnWidth = 14 '调整列宽
.RowHeight = 20 '调整行高
.Font.Size = 12 '字体大小
.HorizontalAlignment = xlCenter '水平对齐
.VerticalAlignment = xlCenter '垂直对齐
.Font.ThemeColor = xlThemeColorLight1 '字体颜色
.Font.ThemeFont = xlThemeFontMinor
End With
'-------------------------------------------------------------设置格式
.Range("A1:D1").MergeCells = True '合并列表
.Range("A1:D1").HorizontalAlignment = xlCenter '水平对齐
.Range("A1:D1").VerticalAlignment = xlCenter '垂直对齐 xlBottom关闭
.Range("A1:D1").Font.Size = 18 '字体大小
.Range("A1:D1").Font.Bold = True '字体加粗
.Range("A1:D1").RowHeight = 30 '调整行高
.Range("A" & L & "," & "B" & L + 1 & "," & "C" & L + 1).HorizontalAlignment = xlRight '线条
.Range("A2" & ":" & "D" & L).Borders.LineStyle = xlContinuous '边框样式
End With
objxls.ActiveWorkbook.SaveAs FileName:=CurrentProject.Path & "\" & strid & "绩效表.xls" ' 导出名称
objxls.ThisWorkbook.Close '关闭工作簿
Set objxls = Nothing
Set rst2 = Nothing
' objxls.Visible = False '是否打开EXCEL
rst1.MoveNext '移到下一条记录
Loop
rst1.MoveFirst
'Set objxls = Nothing
Set rst1 = Nothing
err: Exit Sub
点击下载此附件
