Sub正在影响错误的Excel工作簿

我编写了这个VBA代码，以便从Access表中的数据生成一个报告，并以用户友好的格式将其转储到Excel中。

代码第一次很好用。 但是，如果我在第一次生成的Excel工作表打开时再次运行代码，我的一个子例程会影响第一个工作簿，而不是新生成的工作簿。

为什么？ 我怎样才能解决这个问题？

我认为这个问题是我的工作表和logging集传递给名为GetHeaders的子程序打印列，但我不知道。

 Sub testROWReport() DoCmd.Hourglass True 'local declarations Dim strSQL As String Dim rs1 As Recordset 'excel assests Dim xlapp As excel.Application Dim wb1 As Workbook Dim ws1 As Worksheet Dim tempWS As Worksheet 'report workbook dimentions Dim intColumnCounter As Integer Dim lngRowCounter As Long 'initialize SQL container strSQL = "" 'BEGIN: construct SQL statement { --this is a bunch of code that makes the SQL Statement 'END: SQL construction} 'Debug.Print (strSQL) '***DEBUG*** Set rs1 = CurrentDb.OpenRecordset(strSQL) 'BEGIN: excel export { Set xlapp = CreateObject("Excel.Application") xlapp.Visible = False xlapp.ScreenUpdating = False xlapp.DisplayAlerts = False 'xlapp.Visible = True '***DEBUG*** 'xlapp.ScreenUpdating = True '***DEBUG*** 'xlapp.DisplayAlerts = True '***DEBUG*** Set wb1 = xlapp.Workbooks.Add wb1.Activate Set ws1 = wb1.Sheets(1) xlapp.Calculation = xlCalculationManual 'xlapp.Calculation = xlCalculationAutomatic '***DEBUG*** 'BEGIN: Construct Report ws1.Cells.Borders.Color = vbWhite Call GetHeaders(ws1, rs1) 'Pastes and formats headers ws1.Range("A2").CopyFromRecordset rs1 'Inserts query data Call FreezePaneFormatting(xlapp, ws1, 1) 'autofit formatting, freezing 1 row,0 columns ws1.Name = "ROW Extract" 'Special Formating 'Add borders 'Header background to LaSenza Pink 'Fix Comment column width 'Wrap Comment text 'grey out blank columns 'END: Report Construction 'release assets xlapp.ScreenUpdating = True xlapp.DisplayAlerts = True xlapp.Calculation = xlCalculationAutomatic xlapp.Visible = True Set wb1 = Nothing Set ws1 = Nothing Set xlapp = Nothing DoCmd.Hourglass False 'END: excel export} End Sub Sub GetHeaders(ws As Worksheet, rs As Recordset, Optional startCell As Range) ws.Activate 'this is to ensure selection can occur w/o error If startCell Is Nothing Then Set startCell = ws.Range("A1") End If 'Paste column headers into columns starting at the startCell For i = 0 To rs.Fields.Count - 1 startCell.Offset(0, i).Select Selection.Value = rs.Fields(i).Name Next 'Format Bold Text ws.Range(startCell, startCell.Offset(0, rs.Fields.Count)).Font.Bold = True End Sub Sub FreezePaneFormatting(xlapp As excel.Application, ws As Worksheet, Optional lngRowFreeze As Long = 0, Optional lngColumnFreeze As Long = 0) Cells.WrapText = False Columns.AutoFit ws.Activate With xlapp.ActiveWindow .SplitColumn = lngColumnFreeze .SplitRow = lngRowFreeze End With xlapp.ActiveWindow.FreezePanes = True End Sub 

Answer 1

单独使用单元格和列时，它们引用ActiveSheet.Cells和ActiveSheet.Columns。 尝试以目标图表为前缀：

 Sub FreezePaneFormatting(xlapp As Excel.Application, ws As Worksheet, Optional lngRowFreeze As Long = 0, Optional lngColumnFreeze As Long = 0) ws.Cells.WrapText = False ws.Columns.AutoFit ... End Sub 

Answer 2

好的，我在这里找出了这个问题。 我想我不能使用“.Select”或“Selection”。 当我正在处理一个看不见的，不更新的工作簿。 我发现，当我将代码从自动select改为直接更改单元格的值时，结果就显示出来了。

旧：

  startCell.Offset(0, i).Select Selection.Value = rs.Fields(i).Name 

新：

  ws.Cells(startCell.Row, startCell.Column).Offset(0, i).Value = rs.Fields(i).Name