我们的办公室用户在运行宏时遇到上述错误。在我的研究中,大多数论坛都指出可能存在文件损坏。
我尝试修复有问题的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'