Private Sub Command39_Click()
Dim str1, str2, str3, str4 As String
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
str4 = "D:服务管理系统.accdb"
cnn.Open "provider=microsoft.ace.oledb.12.0; data source=" & str4
str3 = "select * from 费用结算查询 where 费用结算状态='I' order by 服务中心名称"
rs.Open str3, cnn, adOpenKeyset, adLockOptimistic
rs.MoveLast
rs.MoveFirst
Dim i, j, k, m, n As Long
Dim oExcel As Object
Dim oBook As Object
Set oExcel = CreateObject("Excel.Application") '启动Excel
Set oBook = oExcel.Workbooks.Add() '新建Excel文件
oExcel.Visible = True
k = Worksheets.count
str1 = "ABC"
m = 1
Do While Not rs.EOF
If rs("服务中心名称") <> str1 Then '如果当前记录的服务中心名称和上一条记录不同，则创建新的Worksheet
If k <= 0 Then '如果原有Excel的空白Sheets已用完，则创建新的Sheets并激活为当前Sheet
oExcel.Worksheets.Add
Else
oBook.Worksheets(m).Activate
m = m + 1
End If
k = k - 1
str1 = rs("服务中心名称").Value
With oBook.ActiveSheet
.Range(Cells(1, 1), Cells(1, 17)).Merge '标题栏所占单元格合并
.Cells(1, 1) = "KSB项目服务服务统计 KSB Project Service Fee Statistics" '设置表头
.Cells(1, 1).HorizontalAlignment = xlHAlignCenter
.name = str1
End With
End If
Loop
Set oExcel = Nothing
Set oBook = Nothing
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
