我一直在对该代码进行编程，以将Access查询中的值发送到Excel电子表格。每当我运行宏时，都会发生一个错误。出现：“运行=时间错误1004：应用程序定义的错误或对象定义的错误”，它的怪异之处是它随机出现在代码的不同位置，单击“调试”后，我再次按F5而不进行修改任何东西，代码再次运行平稳，好像什么也没发生。
奇怪的是，它按预期方式工作，可以正常工作，可能再次出现该错误几次，但是除了停止该宏之外，什么也没有发生，并且结果令人满意。
奇怪的是，当我在循环中包含msgbox时，该错误没有发生。
'Declare ACCESS objects&variables
Public dbsContract As DAO.Database
Public rstWeightDONE As DAO.Recordset
Public rstWeightTODO As DAO.Recordset
'Declare EXCEL objects&variables
Public objExcelApp As Object
Public wb As Object
Public ws As Object
'Declare Macro variables
Public InitialRow As Integer
Public varRow As Integer 'row variable for excel
Public LastRow As Integer 'Variable to save the highest row value to use later at SUB CellFormulaFormating
Sub DataVisual()
'---------------------------------------------------------------------------------------
'Title: Data Visualization v3
'Description: The purpose of this macro is to transfer the weight Done and To-Do from queries [sum Weight(Done)/Field/IWP]&[sum Weight(Done)/Field/IWP] to
' the contract progress control excel table to visualize the contract progress data.
'---------------------------------------------------------------------------------------
'Declare EXCEL objects&variables
Dim varColumn As Integer 'column variable for excel
'Declare Macro variables
Dim CountOut As Integer
Dim varContract As String
'Set ACCESS variables
Set dbsContract = CurrentDb
Set rstWeightDONE = dbsContract.OpenRecordset("sum Weight(Done)/Field/IWP")
Set rstWeightTODO = dbsContract.OpenRecordset("sum Weight(To-Do)/Field/IWP")
'Here is introduced by the user the contract code that wants to visualize. In order the macro works, it is mandatory the Contract excel file's name has the same name as the contract code introduced
'https://www.excel-easy.com/vba/examples/inputbox-function.html
varContract = InputBox("Introduce the Contract Code you want to Visualize, based on Contract Codes seen at 'Contract List' table from this Database e.g. A0:")
'Set EXCEL variables
Set objExcelApp = CreateObject("Excel.Application")
Set wb = objExcelApp.Workbooks.Open(Application.CurrentProject.Path & "\" & varContract & ".xlsx") 'Declare Path where to find the Excel file. It is mandatory it is placed at the same directory as the ACCESS database.
Set ws = wb.Sheets(1) 'Page number 1 of the excel workbook
varColumn = 3
rstWeightDONE.MoveFirst
rstWeightTODO.MoveFirst
CountOut = 0
InitialRow = 6 '58
'Find Initial Row '-------------------------- MOD 03/07 [ FUNCIONA
Do
If IsEmpty(ws.Cells(InitialRow, 3)) = True Then
CountOut = CountOut + 1
Else
CountOut = 0
End If
If CountOut = 3 Then
InitialRow = InitialRow - 2
Exit Do
End If
InitialRow = InitialRow + 1
Loop Until Mid(ws.Cells(InitialRow + 1, 4), 1, 3) = "CWP" ']
MsgBox InitialRow & " " & Mid(ws.Cells(InitialRow, 4), 1, 3)
CountOut = 0
varRow = InitialRow '@1
HighestRow = 0
Do
If ws.Cells(varRow, varColumn) = "" Then '@2 Checks there is no value inside the cell
CountOut = CountOut + 1
If CountOut = 2 Then 'check there aren't two consecutive blank rows
CountOut = 0
'@6: Creates Missing CWP/IWP in the Excel table
ws.rows(3).copy 'Set-Up Row: Copy Excel CWP row layout
ws.Paste Destination:=ws.rows(varRow) 'Paste it at the required row
ws.Cells(varRow, varColumn) = rstWeightTODO![IOCONST-WBS] 'introduce in excel the CWP Code To-Do value
ws.Cells(varRow, varColumn + 1) = rstWeightTODO![Designation] 'introduce in excel the CWP Description To-Do value
ws.Cells(varRow, varColumn + 3) = "=SUM(F" & varRow + 1 & ")" 'introduce in excel the CWP weight TODO formula
ws.Cells(varRow, varColumn + 4) = "=SUM(G" & varRow + 1 & ")" 'introduce in excel the CWP weight DONE formula
ws.Cells(varRow, varColumn - 1) = rstWeightTODO![IOCONST-WBS] 'introduce in excel the CWP Code To-Do value
varRow = varRow + 1
ws.rows(4).copy 'Set-Up Row: Copy Excel IWP row layout
ws.Paste Destination:=ws.rows(varRow) 'Paste it at the required row
ws.Cells(varRow, varColumn) = rstWeightTODO![IWP-Code] 'introduce in excel the IWP Code To-Do value
ws.Cells(varRow, varColumn + 1) = rstWeightTODO![ActivityDesignation] 'introduce in excel the IWP Description To-Do value
ws.Cells(varRow, varColumn - 1) = rstWeightTODO![IOCONST-WBS] 'introduce in excel the CWP Code To-Do value
varRow = varRow + 1
ws.rows(5).copy 'Set-Up Row: Copy Excel Field row layout
ws.Paste Destination:=ws.rows(varRow) 'Paste it at the required row
'11@
'MsgBox ("Excel Row: " & varRow & " " & "Record (%): " & rstWeightTODO.PercentPosition)
ws.Cells(varRow, varColumn) = rstWeightTODO![IWP-Code] 'introduce in excel the IWP Code To-Do value
ws.Cells(varRow, varColumn + 1) = rstWeightTODO![Field] 'introduce in excel the IWP Description To-Do value
ws.Cells(varRow, varColumn + 3) = rstWeightTODO![Weight (To-Do)] 'introduce in excel the IWP Description To-Do value
ws.Cells(varRow, varColumn - 1) = rstWeightTODO![IOCONST-WBS] 'introduce in excel the CWP Code To-Do value
ws.rows(6).copy 'Set-Up Row: Copy Excel Grayline row layout as separator
ws.Paste Destination:=ws.rows(varRow + 1) 'Paste it at the required row
Call DataEntryDONE(varRow, varColumn) 'Call function
Else
varRow = varRow + 1
End If
Else 'in case there is a value in the checked cell...
CountOut = 0
If ws.Cells(varRow, varColumn) = rstWeightTODO![IWP-Code] And ws.Cells(varRow, varColumn + 1) = rstWeightTODO![Field] Then '@7 Checks if match the cell value with the on-going Access record in review
ws.Cells(varRow, varColumn + 3) = rstWeightTODO![Weight (To-Do)] '@10
Call DataEntryDONE(varRow, varColumn) 'Call function
Else
If ws.Cells(varRow, varColumn) = rstWeightTODO![IWP-Code] And ws.Cells(varRow + 1, varColumn) <> rstWeightTODO![IWP-Code] Then '@8 If the value don't match at @7 then check if there are no more fields by this specific IWP in the Excel
ws.rows(varRow).entirerow.insert '@9 if it's the last designation in the excel, and it did not appear, include it.
'11@
ws.rows(5).copy 'Set-Up Row: Copy Excel Field row layout
ws.Paste Destination:=ws.rows(varRow) 'Paste it at the required row
ws.Cells(varRow, varColumn) = rstWeightTODO![IWP-Code] 'introduce in excel the IWP Code To-Do value
ws.Cells(varRow, varColumn + 1) = rstWeightTODO![Field] 'introduce in excel the IWP Description To-Do value
ws.Cells(varRow, varColumn + 3) = rstWeightTODO![Weight (To-Do)] 'introduce in excel the IWP Description To-Do value
ws.Cells(varRow, varColumn - 1) = rstWeightTODO![IOCONST-WBS] 'introduce in excel the CWP Code To-Do value
Call DataEntryDONE(varRow, varColumn) 'Call function
Else
varRow = varRow + 1 '@5
End If
End If
End If
Loop Until rstWeightTODO.EOF 'Infinite Loop 'rstWeightTODO.AbsolutePosition > 20
Call CellFormulaFormating(varRow, varColumn)
ws.rows(6).copy 'Set-Up Row: Copy Excel Grayline row layout as separator
ws.Paste Destination:=ws.rows(InitialRow - 1) 'Paste it at the required row
wb.Close SaveChanges:=True
Set wb = Nothing
Set objExcelApp = Nothing
MsgBox "The macro has finished."
Exit Sub
End Sub