1. 首页
  2. 问答
  3. vba 1004应用程序未定义或应用程序定义的错误？

vba 1004应用程序未定义或应用程序定义的错误？

2014-10-03 67 views
0

我有下面的代码，我正在运行，以控制Excel中的表单的行为，当用户单击提交这会发送两封电子邮件，并重置我的工作表上的单元格中的一些值和公式。然而，当这运行我得到一个1004错误的应用程序未定义或应用程序定义的错误，我不知道这是为什么？vba 1004应用程序未定义或应用程序定义的错误？

有人可以帮我找出问题的原因。

影响，我相信代码的部分是：

Application.ScreenUpdating = False 



    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim DestRow As Long 
    Set ws1 = Sheets("Home") 
    Set ws2 = Sheets("Statistics") 

    ws1.Range("B10").Value = "" 
    ws1.Range("B15").Value = "" 
    ws1.Range("B20").Value = "" 
    ws1.Range("H10").Value = "" 
    ws1.Range("H15").Value = "" 
    ws1.Range("H20").Value = "" 
    ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")" 
    ws1.Range("N15").Formula = "=IFERROR(INDEX('Depot Data'!$H$1:$H$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")" 
    ws1.Range("B32").Formula = "=IF(C32=""Yes"",B34,IF(ISTEXT(B10),CONCATENATE(""NS"")&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9),""""))" 
    ws1.Range("B34").Formula = "=IF(C34 <>""Yes"",B32,B34)" 
    ws1.Range("N20").Formula = "=IF(ISTEXT(B10),NOW(),"""")" 
    ws1.Range("H32").Formula = "=IF(ISTEXT(B10),""Awaiting Manager Approval"","""")" 
    ws1.Range("N32").Formula = "=IF(ISTEXT(B10),""Request to be Reviewed"","""")" 



    Set InfoBox = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime = 1 
    Select Case InfoBox.Popup("Thank You" & vbNewLine & "Your request has been successfully submitted.", _ 
    AckTime, "Thank You", 0) 
     Case 1, -1 
    End Select 


End If 
End If 
End Sub

继承人我所有的代码放在一起。

在此先感谢！

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Application.DisplayAlerts = False 
If Target.Column = Range("Z1").Column And Range("Z" & ActiveCell.Row).Value = "SUBMIT" Then 
If Range("B10").Value = "" Or Range("B15").Value = "" Or Range("B20").Value = "" Or Range("H10").Value = "" Or Range("H15").Value = "" Or Range("H20").Value = "" Or Range("N10").Value = "" Or Range("N15").Value = "" Or Range("N20").Value = "" Then 
Dim AckTime As Integer, InfoBox As Object 
    Set InfoBox = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime = 1 
    Select Case InfoBox.Popup("Ooops!" & vbNewLine & vbNewLine & "We can't submit this form," & vbNewLine & "you did not complete all the required information.", _ 
    AckTime, "Cannot Submit the Form!", 0) 
     Case 1, -1 
    End Select 

ElseIf Target.Column = Range("Z1").Column And Range("Z" & ActiveCell.Row).Value = "SUBMIT" And Range("B10").Value <> "" Then 

Dim AckTime2 As Integer, InfoBox2 As Object 
    Set InfoBox2 = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime2 = 1 
    Select Case InfoBox2.Popup("Please Wait" & vbNewLine & "We are dealing with your request.", _ 
    AckTime2, "Please Wait", 0) 
     Case 1, -1 
    End Select 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    TempFilePath = "\\UKSH000-File06\Purchasing\New_Supplier_Set_Ups_&_Audits\assets\" 

    strbody = "<p style='color:#000;font-family:calibri;font-size:16'>Dear Purchasing Admin," & vbNewLine & vbNewLine & _ 
       "<br><br>" & "This is an automated email, sent to you from New Suppliers." & vbNewLine & _ 
       "<br>" & "You have a New Supplier Set-Up Request. Please find the details of the application listed below:" & vbNewLine & vbNewLine & _ 
       "<br><br><b>" & "Company Name: " & "</b>" & Range("B10").Value & vbNewLine & _ 
       "<br><b>" & "Company Number: " & "</b>" & Range("B15").Value & vbNewLine & _ 
       "<br><b>" & "Case Reference: " & "</b>" & Range("B32").Value & vbNewLine & _ 
       "<br><br><b>" & "Description of the provisional Supplier: " & "</b>" & "<br>" & Range("B20").Value & vbNewLine & _ 
       "<br><br><b>" & "Current Status: " & "</b>" & Range("Y7").Value & vbNewLine & vbNewLine & _ 
       "<br><b>" & "Request By: " & "</b>" & Range("H15").Value & vbNewLine & vbNewLine & _ 
       "<br><b>" & "Allocated Manager: " & "</b>" & Range("N10").Value & vbNewLine & vbNewLine & _ 
       "<br><b>" & "Allocated Depot " & "</b>" & Range("N15").Value & vbNewLine & vbNewLine & _ 
       "<br><br><br>" & "Note:" & vbNewLine & _ 
       "<br>" & "Please keep a note of your reference number in the event you should have any enquiries. All enquiries should be emailed to [email protected] and you should quote your reference number." & vbNewLine & vbNewLine & _ 
       "<br><br>" & "Kind Regards," & "</font></p>" & vbNewLine & _ 
       "<p style='color:#000;font-family:calibri;font-size:18'><b>Automated Purchasing Email</font></p></b>" & vbNewLine & _ 
       "<br><br><img src='cid:cover.jpg'" & "width='800' height='64'><br>" & vbNewLine & _ 
       "<img src='cid:subs.jpg'" & "width='274' height='51'>" 


    With OutMail 
     .SentOnBehalfOfName = "[email protected]" 
     .To = "[email protected]" 
     .CC = "[email protected]" 
     .BCC = "" 
     .Subject = "New Supplier Request - Reference: " & Range("B32").Value & "" 
     .Attachments.Add TempFilePath & "cover.jpg", olByValue, 0 
     .Attachments.Add TempFilePath & "subs.jpg", olByValue, 0 
     .HTMLBody = strbody 
     'You can add a file like this 
     '.Attachments.Add ("C:\test.txt") 
     .send 'or use .Display 
    End With 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    TempFilePath = "\\UKSH000-File06\Purchasing\New_Supplier_Set_Ups_&_Audits\assets\" 

    strbody = "<p style='color:#000;font-family:calibri;font-size:16'>Dear " & Range("H15").Value & "," & vbNewLine & vbNewLine & _ 
       "<br><br>" & "This is an automated email, sent to you by the purchasing department." & vbNewLine & _ 
       "<br>" & "This is to confirm that we have successfully received your New Supplier Set-Up Request. Whilst we endeavour to complete your supplier request within 3-5 days, please allow upto 10 days for this process to be compelted, the process can be delayed if information is missing or incomplete. That's it for now, you don't need to do anything else, we are carrying out some checks on this supplier and will gather the information we need. We will keep you up to date on the status of your New Supplier Request by email. Please see the information below for your reference." & vbNewLine & vbNewLine & _ 
       "<br><br><b>" & "Supplier Name: " & "</b>" & Range("B10").Value & vbNewLine & _ 
       "<br><b>" & "Case Reference Number: " & "</b>" & Range("B32").Value & vbNewLine & _ 
       "<br><b>" & "Supplier Status: " & "</b>" & Range("Y7").Value & vbNewLine & vbNewLine & _ 
       "<br><br>" & "Note:" & vbNewLine & _ 
       "<br>" & "Please keep a note of your reference number in the event you should have any enquiries. All enquiries should be emailed to [email protected] and you should quote your reference number." & vbNewLine & vbNewLine & _ 
       "<br><br>" & "Kind Regards," & "</font></p>" & vbNewLine & _ 
       "<p style='color:#000;font-family:calibri;font-size:18'><b>Automated Purchasing Email</font></p></b>" & vbNewLine & _ 
       "<br><br><img src='cid:cover.jpg'" & "width='800' height='64'><br>" & vbNewLine & _ 
       "<img src='cid:subs.jpg'" & "width='274' height='51'>" 


    With OutMail 
     .SentOnBehalfOfName = "[email protected]" 
     .To = Range("H22").Value 
     .CC = "[email protected]" 
     .BCC = "" 
     .Subject = "New Supplier Request - Reference: " & Range("B32").Value & "" 
     .Attachments.Add TempFilePath & "cover.jpg", olByValue, 0 
     .Attachments.Add TempFilePath & "subs.jpg", olByValue, 0 
     .HTMLBody = strbody 
     'You can add a file like this 
     '.Attachments.Add ("C:\test.txt") 
     .send 'or use .Display 
    End With 

    Application.ScreenUpdating = False 



    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim DestRow As Long 
    Set ws1 = Sheets("Home") 
    Set ws2 = Sheets("Statistics") 

    ws1.Range("B10").Value = "" 
    ws1.Range("B15").Value = "" 
    ws1.Range("B20").Value = "" 
    ws1.Range("H10").Value = "" 
    ws1.Range("H15").Value = "" 
    ws1.Range("H20").Value = "" 
    ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")" 
    ws1.Range("N15").Formula = "=IFERROR(INDEX('Depot Data'!$H$1:$H$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")" 
    ws1.Range("B32").Formula = "=IF(C32=""Yes"",B34,IF(ISTEXT(B10),CONCATENATE(""NS"")&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9)&RANDBETWEEN(0,9),""""))" 
    ws1.Range("B34").Formula = "=IF(C34 <>""Yes"",B32,B34)" 
    ws1.Range("N20").Formula = "=IF(ISTEXT(B10),NOW(),"""")" 
    ws1.Range("H32").Formula = "=IF(ISTEXT(B10),""Awaiting Manager Approval"","""")" 
    ws1.Range("N32").Formula = "=IF(ISTEXT(B10),""Request to be Reviewed"","""")" 



    Set InfoBox = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime = 1 
    Select Case InfoBox.Popup("Thank You" & vbNewLine & "Your request has been successfully submitted.", _ 
    AckTime, "Thank You", 0) 
     Case 1, -1 
    End Select 


End If 
End If 
End Sub

来源

2014-10-03 james tanner

+0

你添加哪些对象，使得这错误出现在哪里？ – BradyK 2014-10-03 13:06:11

+1

如果在出现错误时单击“调试”，哪一行会突出显示？ – 2014-10-03 13:34:28

回答

0

的问题是在Excel公式：

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"")"

你有你的引号内的引号。 VBA看到： "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"和")"，不知道为什么你会把它们贴在一起。你需要要么使用一个字符代码chr(34)你的内心引号或双他们，让他们正确地转义

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)), " & chr(34) & chr(34) & ")"

或

ws1.Range("N10").Formula = "=IFERROR(INDEX('Depot Data'!$F$1:$F$10004,MATCH(H20,'Depot Data'!$E$1:$E$10004,0)),"""")"

来源

2014-10-03 13:57:00 JNevill

相关问题

 相关问题