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

Sub正在影响错误的Excel工作簿,excel,ms-access,vba,Excel,Ms Access,Vba,我编写这段VBA代码是为了从Access表中的数据生成一个报告,并使用用户友好的格式将其转储到Excel中 这段代码第一次就非常有效。但是,如果在第一个生成的Excel工作表打开时再次运行代码,我的一个子例程会影响第一个工作簿,而不是新生成的工作簿 为什么??我怎样才能解决这个问题 我认为问题在于我将工作表和记录集传递给名为GetHeaders的子例程,该子例程打印列,但我不确定 Sub testROWReport() DoCmd.Hourglass True 'local declarat

我编写这段VBA代码是为了从Access表中的数据生成一个报告,并使用用户友好的格式将其转储到Excel中

这段代码第一次就非常有效。但是,如果在第一个生成的Excel工作表打开时再次运行代码,我的一个子例程会影响第一个工作簿,而不是新生成的工作簿

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

我认为问题在于我将工作表和记录集传递给名为
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

单独使用单元格和列时,它们指的是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

单独使用单元格和列时,它们指的是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

好吧,我在这里解决了问题。当我使用一个不可见的、不更新的工作簿时,我想我不能使用“.Select”或“Selection.”。我发现,当我将一些代码从自动选择更改为直接更改单元格的值时,它就成功了

旧的:

新的:


好吧,我在这里解决了问题。当我使用一个不可见的、不更新的工作簿时,我想我不能使用“.Select”或“Selection.”。我发现,当我将一些代码从自动选择更改为直接更改单元格的值时,它就成功了

旧的:

新的:


乍一看很难说,但真正有帮助的是做一个测试,尝试一下,并在这里与我们分享。这将使问题更容易、更快速地诊断。我同意,我很抱歉没有给出一个更可验证的示例,但我需要提供很多资产,包括带有SQL语句的数据库。谢谢你看了一下:-)不,你不会的。这是“最小、完整和可验证”的“最小”部分。剥掉不会导致错误的东西。只保留你例子中的内容。哦,是的,你肯定是对的。我以为你在我的例子中提到了不完整性。我通常很难在最小部分和完整部分之间取得平衡……乍一看很难说,但真正能帮助你的是做一个测试,尝试一下,并在这里与我们分享。这将使问题更容易、更快速地诊断。我同意,我很抱歉没有给出一个更可验证的示例,但我需要提供很多资产,包括带有SQL语句的数据库。谢谢你看了一下:-)不,你不会的。这是“最小、完整和可验证”的“最小”部分。剥掉不会导致错误的东西。只保留你例子中的内容。哦,是的,你肯定是对的。我以为你在我的例子中提到了不完整性。我通常很难平衡最小部分和完整部分。。。
    ws.Cells(startCell.Row, startCell.Column).Offset(0, i).Value = rs.Fields(i).Name