Excel 2010宏错误“1004方法打开工作簿失败”

时间:2014-10-20 20:09:13

标签: excel-vba vba excel

我们的办公室用户在运行宏时遇到上述错误。在我的研究中,大多数论坛都指出可能存在文件损坏。

我尝试修复有问题的Excel文件" PO_Summary"并尝试将内容复制到新文件,并用新文件替换旧文件。我也试过传递参数CorruptLoad:xlrepair选项。但现在我收到了错误:

  

运行时错误9脚本超出范围。

这是脚本。

Sub reqno()

Dim flname$, srno, newsrno, nsrno$, Leng, I, fname$, user$
Dim str1$, str2$, str3$, str4$, str5$, str6$, str7$, str8$, str9$, str10$, str11$, str12$
Dim r, j, d As Long
'Error Handling
If (ActiveSheet.Range("AH2:AH2") > 0) Then
        str4$ = "   __ ERRORS ________________________________________________"
        str5$ = ActiveSheet.Range("AH3:AH3")  'Error 1
        str6$ = ActiveSheet.Range("AH4:AH4")  'Error 2
        str7$ = ActiveSheet.Range("AH5:AH5")
        str8$ = ActiveSheet.Range("AH6:AH6")
        str9$ = ActiveSheet.Range("AH7:AH7")
        str10$ = ActiveSheet.Range("AH8:AH8")
        str11$ = ActiveSheet.Range("AH9:AH9")
        str12$ = "  __________________________________________________________"

    ConstVbinfotext = 2147483625

    j = MsgBox(" 'Purchase Requisition Form' can not be generated, due to the following errors." & _
        Chr(13) & Chr(13) & str4$ & Chr(13) & Chr(13) & str5$ & Chr(13) & str6$ & Chr(13) & str7$ & Chr(13) & str8$ & _
        Chr(13) & str9$ & Chr(13) & str10$ & Chr(13) & str11$ & Chr(13) & str12$ & Chr(13) & Chr(13) _
        + "                    Regenerate the requisition once fields are duly filled" & Chr(13), _
        vbApplicationModal + vbCancelonly, "I N C O M P L E T E  Requisition Form")

Else
         r = MsgBox("Are you sure you want to Generate Purchase Requisition?", _
         vbQuestion + vbYesNo, "PCDO Purchase Requisition")
        'If ok
    If r = vbYes Then
        flname$ = "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\Counter\reqno.TXT"

        Open flname$ For Input As 1
            While Not EOF(1)
                Input #1, srno
            Wend
        Close 1
        newsrno = srno + 1
        user$ = UCase(Application.UserName)
        Open flname$ For Output As 1
            Write #1, newsrno
        Close 1
            nsrno$ = newsrno


            ActiveSheet.Shapes("Button 42").Select
            Selection.Delete

            ActiveSheet.Shapes("Button 61").Select
            Selection.Delete

        fname$ = UCase("C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\" + nsrno$ + "_" + user$ + ".xls")
        ThisWorkbook.CheckCompatibility = False
        ActiveWorkbook.SaveAs Filename:=fname$, FileFormat:=xlNormal, Password:="Benreqn", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        str1$ = "                           Your Purchase Request Has Been Registered As                         "
        str2$ = "                                                    " & (nsrno$) & "_" & user$ & ".xls                                         "
        ActiveSheet.Range("J2:J2") = nsrno$
        'Update the Summary file
        Sheets("PO").Select
        Sheets("database").Visible = True
        Sheets("database").Select
        UnProtect
            Sheets("database").Select
            Range("A2:X21").Select
            Selection.Copy
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("A2").Select
        Dim countnonblank As Integer, myRange As Range
        Set myRange = Columns("A:A")
            countnonblank = Application.WorksheetFunction.Count(myRange)
            Range("A" & countnonblank + 1, "X2").Select
            Selection.Copy
            ActiveWindow.SelectedSheets.Visible = False
            Sheets("PO").Select

            Workbooks.Open Filename:= _
                "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\PO_Smmary.xlsx", CorruptLoad:=xlrepair
            Sheets("Summary").Select
            Range("A1").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Range("A1:V25000").Select
            Application.CutCopyMode = False
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A25000") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A1:X25000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            Range("A1").Select
            ThisWorkbook.CheckCompatibility = False
            ThisWorkbook.Save
            ActiveWorkbook.Save
            ActiveWindow.Close

        Sheets("PO").Select
        Range("J5").Select

    Sheets("PO").Select
    Range("A1:J80").Select

    ExecuteExcel4Macro "PRINT(1,,,1,,TRUE,,,,,,1,,,TRUE,,FALSE)"
        Sheets("PO").Select
        Range("J5").Select
        MsgBox str1$ & Chr(13) & str2$ & Chr(13)
        ThisWorkbook.CheckCompatibility = False
        Sheets("database").Visible = True
        Sheets("database").Select
        Protect
        Sheets("database").Visible = False

        ThisWorkbook.Save
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Else
        MsgBox "Purchase Requisition is not processed", _
            vbInformation + vbOKOnly, "Not Processed"
    End If
    End If

End Sub

以下是我遇到问题的脚本部分。只需复制零件供您参考。

Workbooks.Open Filename:= _
                "C:\Users\Jamsheer\Desktop\Macro_Excel\Benefit_Purch_Reqn\PO_Smmary.xlsx", _
                CorruptLoad:=xlrepair
            Sheets("Summary").Select
            Range("A1").Select
            NextRow = Range("A65536").End(xlUp).Row + 1
            Range("A" & NextRow).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Range("A1:V25000").Select
            Application.CutCopyMode = False
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A25000") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A1:X25000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            Range("A1").Select
            ThisWorkbook.CheckCompatibility = False
            ThisWorkbook.Save
            ActiveWorkbook.Save
            ActiveWindow.Close'

0 个答案:

没有答案