Access vba的Excel小计有什么方法？

我有一个Access 2010应用程序，我运行SQL查询并将结果输出到Excel。 我正在使用Excel小计命令来创build小计。 这工作正常，但总行只有文本（“XXX计数”）是粗体和值不粗体。 我们的客户希望整个行大胆。 我已经尝试了几个方法没有成功。 我如何做小计中的整个行？

所以这里是我现在有：

这是正确的，除了我需要这样的所有行5,8,16和17粗体：

这里是我的代码来创buildAccess文件的Excel文件（除了大胆的问题，这所有的作品）：

Public Sub ExportToExcel(query) Dim appXL As Object Dim wbk As Object Dim wksNew As Object Set appXL = CreateObject("Excel.Application") Set wbk = appXL.Workbooks.Add Set wksNew = wbk.Worksheets("Sheet1") Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set appXL = CreateObject("Excel.Application") appXL.Visible = True Set wbk = appXL.Workbooks.Add Set wksNew = wbk.Worksheets(1) Set cn = CurrentProject.AccessConnection Set rs = New ADODB.Recordset With rs Set .ActiveConnection = cn .Source = query .Open End With With rs 'Put recordset into new wks wksNew.Cells(2, 1).CopyFromRecordset rs 'And add headers Dim i As Long For i = 0 To .Fields.Count - 1 wksNew.Cells(1, i + 1).Value = .Fields(i).Name wksNew.Cells(1, i + 1).Font.Bold = True wksNew.Cells(1, i + 1).HorizontalAlignment = xlCenter Next i 'Now, while the recordset is available... 'The recordset has .fields.count fields 'Subtotals are wanted from field 7 to the end If .Fields.Count > 13 Then ReDim ary(14 To .Fields.Count - 1) For i = LBound(ary) To UBound(ary) ary(i) = i Next i wksNew.Cells(1, 1).CurrentRegion.SubTotal GroupBy:=1, _ TotalList:=ary, Replace:=True, PageBreaks:=False, SummaryBelowData:=True End If .Close End With End Sub 

我尝试了这个基于这个网站的代码：

 Dim rCell As Range wksNew.Columns("A:A").Select Dim rCell As Range For Each rCell In Selection If Right(rCell.Value, 5) = "Count" Then Rows(rCell.Row).Interior.ColorIndex = 36 End If Next 

但是它在项目rCell.Value上返回了“找不到方法或数据成员”错误。

我也试过这样的：

  Dim rCell As Range wksNew.Columns("A:A").Select For Each rCell In Selection If Right(rCell, 5) = "Count" Then Selection.Font.Bold = True End If Next 

但是在For Each行中出现错误“ActiveX组件无法创build对象”。

我如何大胆整个行的小计？

Answer 1

你得到一个错误，因为Access不知道Selection是什么，除非你告诉它它已经连接到你的Excel实例。

 For Each rCell In Selection 

但是，不需要select任何内容，或者查看整个列：

  Dim rCell As Range For Each rCell In wksNew.UsedRange.Columns(1).Cells If Right(rCell, 5) = "Count" Then rCell.Font.Bold = True End If Next 

Answer 2

你有没有试过一个枢轴表？ pipe理格式或布局比较容易，而且您不必更改代码太多，因为您只需将RecordSet放在PivotTableCache就像第二个示例一样。

Answer 3

而不是循环，我build议折叠轮廓和格式化可见单元格：

 with wksNew.Cells(1, 1).CurrentRegion .Outlinelevel = 2 .specialcells(12).Font.Bold = True .Outlinelevel = 3 End With 

Answer 4

感谢所有的build议。 没有人发布了一个完全可行的解决scheme，所以这是我最终使用的：

  Dim c As Object For Each c In wksNew.Range("A1:A500") If c.Value Like "*Total" Then c.Offset(0, 13).Font.Bold = True c.Offset(0, 14).Font.Bold = True c.Offset(0, 15).Font.Bold = True End If Next 

唯一让我担心的是我认为这只有500行。 我无法find一个方法来find行数，并只search这些。 如果我包括整个专栏，花了几分钟来完成我不认为客户想要的循环。 有关如何find最后一行的build议？

Answer 5

我会

1. 显示大纲2级，所有小计
2. select整个区域
3. 使用GoTo Specialselect仅可见的单元格
4. 应用格式
5. 如果应该不同，请更改标题行格式
6. 再次显示所有级别（级别3）

此代码演示：

 Sub Macro4() Application.ScreenUpdating = False ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Font.Bold = True 'change the header row if necessary Range(Range("A1"), Range("A1").End(xlToRight)).Font.Italic = True ActiveSheet.Outline.ShowLevels RowLevels:=3 End Sub