Question

我正在向MS Access DB添加功能。在我的机器上，代码永远不会崩溃。在其他计算机上（包括Access的非运行时副本），一个小的更改会导致崩溃。代码在Excel中格式化导出的查询：

Option Compare Database

Public Function format_status_report(ByVal filename As String, ByVal path As String)
    Dim obj_excel As Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim rng As Range
    Dim tbl As ListObject
    Const LAST_COL = 10

    last_col_char = Chr(LAST_COL + 64)
    Set obj_excel = New Excel.Application

    On Error GoTo ErrorHandler
    obj_excel.Visible = False
    obj_excel.DisplayAlerts = False
    obj_excel.Workbooks.Open (path & filename)
    obj_excel.ScreenUpdating = False
    Set wb = obj_excel.Workbooks(filename)
    Set ws = wb.Sheets(1)

    num_rows = count_rows(ws)
    For i = 2 To num_rows
        If (ws.Cells(i, LAST_COL)) Then
            ws.Range("A" & Trim(Str(i)) & ":" & last_col_char & Trim(Str(i))).Interior.ColorIndex = 23
        Else
            ws.Range("A" & Trim(Str(i)) & ":" & last_col_char & Trim(Str(i))).Interior.ColorIndex = 10
        End If
    Next

    ws.Range("A1:" & last_col_char & Trim(Str(1))).Interior.ColorIndex = 16
    For i = 1 To LAST_COL
        ws.Cells(1, i) = Replace(ws.Cells(1, i), "_", " ")
    Next

    Set rng = ws.Range(ws.Range("A1"), ws.Range("A1").SpecialCells(xlLastCell))
    Set tbl = ws.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium16"
    ws.Columns(last_col_char).Hidden = True
    ws.Columns("I").ColumnWidth = 60
    ws.Rows("1:" & Trim(Str(num_rows))).AutoFit

    For Each Row In ws.Rows("1:" & Trim(Str(num_rows)))
        If Row.RowHeight < 30 Then
            Row.RowHeight = 30
        End If
    Next
    obj_excel.ScreenUpdating = True
    obj_excel.Visible = True
    wb.Save
    obj_excel.WindowState = xlMaximized
    Exit Function

ErrorHandler:
    err_msg
    wb.Close
    obj_excel.Quit
End Function


Private Function count_rows(ByRef ws As Worksheet) As Integer
    c = ws.Cells(1, 1)
    i = 0
    Do Until (Len(c) < 8)
        i = i + 1
        c = ws.Cells(i + 1, 1)
    Loop
    count_rows = i
End Function


Private Sub err_msg()
    MsgBox "Error occured? " & Err.Number & ": " & Err.Description
End Sub

如果在以下循环中更改了颜色值，则会发生崩溃。

For i = 2 To num_rows
    If (ws.Cells(i, LAST_COL)) Then
        ws.Range("A" & Trim(Str(i)) & ":" & last_col_char & Trim(Str(i))).Interior.ColorIndex = 23
    Else
        ws.Range("A" & Trim(Str(i)) & ":" & last_col_char & Trim(Str(i))).Interior.ColorIndex = 10
    End If
Next

在到达断点之前，访问将崩溃（在我的机器上运行）。 Windows错误消息：

Problem signature:
  Problem Event Name:   BEX
  Application Name: MSACCESS.EXE
  Application Version:  14.0.7162.5001
  Application Timestamp:    5626f514
  Fault Module Name:    MSVCR90.dll
  Fault Module Version: 9.0.30729.6161
  Fault Module Timestamp:   4dace5b9
  Exception Offset: 000320f0
  Exception Code:   c0000417
  Exception Data:   00000000
  OS Version:   6.1.7601.2.1.0.256.48
  Locale ID:    1033
  Additional Information 1: 2f13
  Additional Information 2: 2f1305af727fc04ce417c25a567e9372
  Additional Information 3: a621
  Additional Information 4: a62129d4ea5fc426ef3a2d423daed40d

这似乎是某种图形错误。但是，我失去了什么可能导致ColorIndex = 23和ColorIndex = 10没问题，而我尝试的任何其他指数都会导致崩溃。我已经在运行时版本上检查了启动时的引用，看起来没问题。

编辑：看起来它是导致问题的Excel对象引用，这很奇怪，因为我的refcheck在任何机器上都显示了它的完整路径，无论MS Office的版本如何。通过实验，我确定代码运行只要它们运行与开发副本中选择的引用相同的Office版本。

Edit2：我没记住VBA.CreateObject函数。使用它来创建Excel对象而不是包含对Excel库的引用似乎可以解决源自不同办公室版本的所有问题。

Answer 1

我发现（不太了解）当Excel Visible属性设置为False时，通过Interior对象引用Cell的Excel.Application属性更安全。
在你的情况下：

For i = 2 To num_rows
    ws.Range("A" & Trim(Str(i)) & ":" & last_col_char & Trim(Str(i))).Select
    If (ws.Cells(i, LAST_COL)) Then
        obj_excel.Application.Selection.Interior.ColorIndex = 23
    Else
        obj_excel.Application.Selection.Interior.ColorIndex = 10
    End If
Next

着色Excel单元格时访问崩溃

1 个答案: