Vba 下标超出范围-大多数计算机工作正常（包括我的）

我是vba的新用户

最近出现了一个vba问题，在某个特定用户的计算机上，当其他用户似乎都没有使用宏（包括我自己）的问题时，我变得相当无知和无助-下标超出范围-因此我不能简单地尝试和错误排除故障

因此，我真的需要你们所有人的专家帮助！真的非常感谢

我使用了一系列vba，它们将一个接一个地运行，并按如下时间顺序粘贴它们

VBA 1

Sub VBA_1()
Dim ws As Worksheet

        For Each ws In ActiveWorkbook.Worksheets

        ws.Outline.ShowLevels 1, 1

        Next ws
    End Sub

VBA 2

Sub VBA_2()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets

ws.Protect ("Password")

Next ws

End Sub

VBA 3

Sub VBA_3()
Dim iRet As Integer
Dim strPrompt As String



'Prompt
strPrompt = "This will take about 2 minutes. Click 'OK' to proceed."

'Show msgbox
iRet = MsgBox(strPrompt, vbOKCancel)

'When user clicked 'OK'..
If iRet = vbOK Then

'SaveAs Function
Dim fName As String

fName = Application.GetSaveAsFilename(, "Excel Binary Workbook (*.xlsb), *.xlsb")
If fName = "False" Then
MsgBox "File not saved.", vbOKOnly
Cancel = True
End If

Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlExcel12
Application.EnableEvents = True

' Calculate
   Application.Calculate
   Application.ScreenUpdating = True


' Outlet
    Worksheets("Total Outlets").Activate
'Copy and Paste this portion to each worksheet
        For Each cell In Range("A1")
            If cell.Value = "Not Applicable" Then
            ActiveSheet.Visible = xlSheetHidden
        Else
            Call HypMenuVRefresh
        End If
    Next
'End Outlet & Copy and Paste

    Worksheets("D11101").Activate
        For Each cell In Range("A1")
            If cell.Value = "Not Applicable" Then
            ActiveSheet.Visible = xlSheetHidden
        Else
            Call HypMenuVRefresh
        End If
    Next

    Worksheets("D11102").Activate
        For Each cell In Range("A1")
            If cell.Value = "Not Applicable" Then
            ActiveSheet.Visible = xlSheetHidden
        Else
            Call HypMenuVRefresh
        End If
    Next

'Hide sheets accordingly
Worksheets("Restaurant List").Visible = xlSheetVeryHidden
Worksheets("Hotel List").Visible = xlSheetVeryHidden

'Recalculate
Application.Calculate
Application.ScreenUpdating = True


'Renaming of tabs
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    If ws.Range("A2").Value = 1 Then
        If ws.Visible = xlSheetVisible Then
            On Error Resume Next
                ws.Name = ws.Range("A10").Value
        End If
    End If
Next ws


'Save Workbook
ActiveWorkbook.Save

'Enable finishing screen to be 'Input'
Sheets("Input").Select

'Show msgbox
MsgBox ("Retrieval Completed!")


Else

MsgBox ("Retrieval of Data Cancelled")

End If

End Sub

---

我可以想到以下可能的原因，但不说其中任何一个是真正的原因：

“…在特定用户的计算机上…”

然后：

• Excel/VBA的版本不同

• 有些设置了全局

  选项库

  （但我认为这不能设置为全局，即适用于所有加载的工作簿）

• 某个地方的分隔符是“硬编码”的，不符合Windows全局设置（控制面板-->区域和语言-->格式-->其他设置）

• 语言与VBA中的反射不同（例如，母语中的关键字/函数名或带有非US ASCII 7位字符的标识符名）

---

要查找程序遇到错误（并停止）的位置，请创建一个函数，在每个主要步骤后将状态消息写入文件。确保在每条消息之后关闭文件，以便消息被实际写入。

它会在哪一行抛出错误？将

ActiveWorkbook

替换为

ThisWorkbook

，将

ActiveSheet

替换为

ThisWorkbook.Worksheets（“工作表名称”）

如果仍然出现问题，请发布

HypMenuVRefresh

的代码，这很难说，但很可能是这样的代码将您扔掉了…..工作表（），如果工作表不存在，或者无法访问（不确定后面的工作表），则会抛出此错误我建议结束这个问题，因为OP没有告诉我们错误发生在哪里。@PaulOgilvie，因为OP不知道，正如问题开头所解释的那样。