excel vba宏中的应用程序定义或对象定义错误 [英] Application-defined or object-defined error in excel vba macro
问题描述
我们最近从办公室2003迁移到了办公室2007.我们有一个excel电子表格，其中包含突然停止工作的vba宏。以下是我们遇到问题的代码。错误是在粗体线处生成的，但我认为实际问题可能是使用（带下划线）的线程序。有人可以提供帮助吗？ Sub ImportNewProgram（） '添加新表格，必要时删除 UpdateStatus"正在检查程序..." Dim w 对于每个w在工作表中 如果w.Name = NewProgramForm.Programs.Text那么 如果MsgBox（"程序"& NewProgramForm.Programs.Text&"已经存在。删除并重新创建工作表？"，vbYesNo，"Program Already"存在"）= vbNo然后 w.Activate StatusDialog.Hide 卸载StatusDialog 退出子 结束如果 w.Activate 如果不是ActiveWorkbook.Worksheets（" NewProgramForm.Programs.Text"）。删除然后 w .Activate StatusDialog.Hide 卸载StatusDialog 退出Sub 结束如果 结束如果 下一步 UpdateStatus" Creating worksheet ..." 工作表（" NewProgramSheetShell" ）.Copy After：= Worksheets（" Home"） ActiveSheet.Name = NewProgramForm.Programs.Text Dim sheet Set sheet = Worksheets（NewProgramForm.Programs。文本） ActiveSheet.Visible = False 工作表（"Home"）。激活 使用sheet.Cells（sheet.Range（" CreationDate"）。Row，sheet.Range（" CreationDate"） .Column） .Value =" - 创建：" &安培;现在 .Font.Italic = True 结束 '设置旅行日期 UpdateStatus"Set birthday cutoff ..."< p> sheet.Cells（sheet.Range（" ParamAdultBirthday"）。Row，sheet.Range（" ParamAdultBirthday"）。Column）.Value =（NewProgramForm.BdayMonth.ListIndex + 1）& " /" &安培; NewProgramForm.BdayDay.Value& " /" &安培; NewProgramForm.BdayYear '加载客户 UpdateStatus"加载客户..." Dim sqlRS 设置sqlRS = CreateObject（" ADODB.Recordset"） sqlRS.Open" SELECT DISTINCT cep.borrowedSales AS extendSales，cep.carryOverCurrYr AS carryOver，p.progId，cl.custNum，cl.custName，cl.tripDollarsYTD，cl.custAlpha，ce.manualDeduct， ce.creditDeduct FROM Registrations r" &安培; _ " INNER JOIN程序p ON r.program = p.progId" &安培; _ " INNER JOIN CustomerLive cl ON r.customer = cl.custNum" &安培; _ " LEFT OUTER JOIN CustomerEdit ce ON r.customer = ce.custNum AND cl.tripYear = ce.TripYear" &安培; _ " LEFT OUTER JOIN CustomerEdit cep ON cl.custNum = cep.custNum AND cl.tripYear - 1 = cep.TripYear" &安培; _ "在哪里p.progTitle ='" &安培; NewProgramForm.Programs.Text& "'AND cl.tripYear =" &安培; NewProgramForm.TripYear.Text& " AND r.cancelDate IS NULL且r.registerDate IS NOT NULL" &安培; _ " ORDER BY cl.custAlpha"，DSN_SQL，1,1 Dim i i = 0 虽然不是sqlRS.EOF sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" ; RefNumRange"）。列）.Value = sqlRS（" progId"）& " - " &安培; sqlRS（" custNum"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" CustomerNumRange"）。Column）.Value = sqlRS（" custNum"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" CustomerNumRange"）。Column + 1 ）.Value = sqlRS（" custName"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" CustomerNumRange"））。列+ 2）.Value = sqlRS（" custAlpha"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" QualSalesRange" ;）。列）.Value = sqlRS（" tripDollarsYTD"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" CarryOverRange"）。Column）.Value = sqlRS（" carryOver"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" ; ManualDeductRange"）。Column）.Value = sqlRS（" manualDeduc t"） sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" CreditDeductRange"）。Column）.Value = sqlRS（" ; creditDeduct"） 如果不是IsNull（sqlRS（" extendSales"））和IsNumeric（sqlRS（" extendSales"））那么 sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" ExtendSalesRange"）。Column）.formula =" = if（" &安培; sheet.Cells（sheet.Range（" CustomerNumRange"）。Row + i，sheet.Range（" PrevTripRange"）。Column）.Address& "> 0,0，" &安培; sqlRS（" extendSales"）& "）" 结束如果 i = i + 1 sqlRS.MoveNext Wend sqlRS.Close '加载注册 更新 卸载NewProgramForm UpdateStatus" Done。" StatusDialog.Hide 卸载StatusDialog sheet.Visible = True sheet.Activate End Sub
您好，我在从Excel 03迁移到07时遇到类似问题，我还将其缩小为 With 语句。
使用wbkWorkbook.Worksheets（"Sheet 1"）
;&NBSP; Do Until .Cells（mlRow，5）.Value =""
由于某种原因，它似乎适用于某些Excel 2007电子表格而不是其他电子表格。
你设法找出这个问题的原因吗？
We recently migrated from office 2003 to office 2007. We have a excel spreadsheet with vba macros that suddenly has quit working. Following is the code that we are having problems with. The error is generated at the bolded line but I believe that actual problem may be with a line proceding that (underlined). Can anyone help? Sub ImportNewProgram() ' Add new sheet, delete if necessary UpdateStatus "Checking for program..." Dim w For Each w In Worksheets If w.Name = NewProgramForm.Programs.Text Then If MsgBox("The program " & NewProgramForm.Programs.Text & " already exists. Delete and recreate the sheet?", vbYesNo, "Program Already Exists") = vbNo Then w.Activate StatusDialog.Hide Unload StatusDialog Exit Sub End If w.Activate If Not ActiveWorkbook.Worksheets("NewProgramForm.Programs.Text").Delete Then w.Activate StatusDialog.Hide Unload StatusDialog Exit Sub End If End If Next UpdateStatus "Creating worksheet..." Worksheets("NewProgramSheetShell").Copy After:=Worksheets("Home") ActiveSheet.Name = NewProgramForm.Programs.Text Dim sheet Set sheet = Worksheets(NewProgramForm.Programs.Text)
ActiveSheet.Visible = False Worksheets("Home").Activate With sheet.Cells(sheet.Range("CreationDate").Row, sheet.Range("CreationDate").Column)
.Value = " - Created: " & Now .Font.Italic = True End With ' Set travel date UpdateStatus "Set birthday cutoff..." sheet.Cells(sheet.Range("ParamAdultBirthday").Row, sheet.Range("ParamAdultBirthday").Column).Value = (NewProgramForm.BdayMonth.ListIndex + 1) & "/" & NewProgramForm.BdayDay.Value & "/" & NewProgramForm.BdayYear ' Load customers UpdateStatus "Loading customers..." Dim sqlRS Set sqlRS = CreateObject("ADODB.Recordset") sqlRS.Open "SELECT DISTINCT cep.borrowedSales AS extendSales, cep.carryOverCurrYr AS carryOver, p.progId, cl.custNum, cl.custName, cl.tripDollarsYTD, cl.custAlpha, ce.manualDeduct, ce.creditDeduct FROM Registrations r" & _ " INNER JOIN Programs p ON r.program = p.progId" & _ " INNER JOIN CustomerLive cl ON r.customer = cl.custNum" & _ " LEFT OUTER JOIN CustomerEdit ce ON r.customer = ce.custNum AND cl.tripYear = ce.TripYear" & _ " LEFT OUTER JOIN CustomerEdit cep ON cl.custNum = cep.custNum AND cl.tripYear - 1 = cep.TripYear" & _ " WHERE p.progTitle = '" & NewProgramForm.Programs.Text & "' AND cl.tripYear = " & NewProgramForm.TripYear.Text & " AND r.cancelDate IS NULL AND r.registerDate IS NOT NULL" & _ " ORDER BY cl.custAlpha", DSN_SQL, 1, 1 Dim i i = 0 While Not sqlRS.EOF sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("RefNumRange").Column).Value = sqlRS("progId") & "-" & sqlRS("custNum") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column).Value = sqlRS("custNum") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column + 1).Value = sqlRS("custName") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column + 2).Value = sqlRS("custAlpha") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("QualSalesRange").Column).Value = sqlRS("tripDollarsYTD") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CarryOverRange").Column).Value = sqlRS("carryOver") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("ManualDeductRange").Column).Value = sqlRS("manualDeduct") sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CreditDeductRange").Column).Value = sqlRS("creditDeduct") If Not IsNull(sqlRS("extendSales")) And IsNumeric(sqlRS("extendSales")) Then sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("ExtendSalesRange").Column).formula = "=if(" & sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("PrevTripRange").Column).Address & ">0,0," & sqlRS("extendSales") & ")" End If i = i + 1 sqlRS.MoveNext Wend sqlRS.Close ' Load registrations Update Unload NewProgramForm UpdateStatus "Done." StatusDialog.Hide Unload StatusDialog sheet.Visible = True sheet.Activate End Sub
Hi there, I'm having a similar issue with migrating from Excel 03 to 07, I also narrowed it down to a With statement.
With wbkWorkbook.Worksheets("Sheet 1")
Do Until .Cells(mlRow, 5).Value = ""
It seems to work in some Excel 2007 spreadsheets and not in others for some reason.
Did you manage to find out the reason for this issue?
这篇关于excel vba宏中的应用程序定义或对象定义错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
