我正在向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库的引用似乎解决了源自不同Office版本的所有问题。
我发现(不太了解)当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