VBA不会从其自己的工作簿中调用UserForm
我的工作表上有一个CMDbutton，其代码如下：
Private Sub cmdBlastoff_Click() UserForm2.Show vbModeless 'launch gateway userform End Sub 此代码工作了很长时间，但现在正在生成“错误9：下标超出范围”。
我试图调用的用户窗体（UserForm2）位于相同的工作簿中。
我将把下面的userform的完整代码放在相关的情况下，但是它的Userform_initialize子代码中的代码是：
Private Sub userform_initialize() Sheets("hiddensheet1").Range("B5").Value = "v7.04" 'sets version # in hidden sheet FileNameChecker_local 'runs a sub (located below in the userform module) to determine the filename and path ValueInjector 'runs a sub (located below in the userform module) to put some values into text fields on the userform cmdBigGo.Font.Size = 15 'sets font size of a button End Sub
正如我刚才所说，这是一直工作到最近，我没有想法。 到目前为止我已经尝试过：
- 1）通过在工作簿前面指定工作簿，find某种方法来明确指出userform2的确切位置：
ActiveWorkbook.UserForm2.show（因为现在显而易见的原因，不起作用）我把一个更明确的调用看作是最可能的修复，但不知道如何去做 - 2）从调用button调用中删除
vbModeless - 3）显式地将
ActiveWorkbook设置为一个我所有的东西存储在，这是调用button的位置（这不应该是必要的，我知道）
任何其他的想法？
UserForm2的完整代码（可能不相关，所有在此问题出现之前工作）：
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As Long, _ ByVal lpfnCB As Long) As Long 'should check to see if there is an output folder in the directory where COGENT sits and if not create it 'should pull default filepath to the outputs folder from the hiddensheet 'should call data baster on terminate 'DONE should allow the user to change the default save location 'DONE should allow them to change the save location THIS time. 'DONE should pull filepath from hiddensheet, check against original (?) and 'DONE Should create a default filename Public strFileFullName As String Public strFileJustPath As String Public strUserFolderName As String Public strFileName As String Public strRawDate As String Public strDLlink As String Public strDLdest As String Public strDLlocalName As String Public strDLNameOnWeb As String Public strOpenURLPointer As String Dim strSaveAsErrHandler As String Dim strQueryID As String Private Sub userform_initialize() Sheets("hiddensheet1").Range("B5").Value = "v7.04" 'sets version # in hidden sheet FileNameChecker_local 'runs a sub (located below in the userform module) to determine the filename and path ValueInjector 'runs a sub (located below in the userform module) to put some values into text fields on the userform cmdBigGo.Font.Size = 15 'sets font size of a button End Sub Private Sub chkCyberDiv_Click() If chkCyberDiv.Value = True Then '==Cyber OUs visible== chkNDIO.Visible = True txtQueryID.Value = "169436" '==Other Div OUs invisible== chkCivilDiv.Value = False Else chkNDIO.Visible = False End If End Sub Private Sub chkCivilDiv_Click() If chkCivilDiv.Value = True Then '==Civil OUs visible== chkCivilInfoSys.Visible = True '==Other Div OUs invisible== chkCyberDiv.Value = False Else chkCivilInfoSys.Visible = False End If End Sub Sub cmdBigGo_Click() '==========Check if SaveAsNewName worked and if not kill sub========== SaveAsNewName If strSaveAsErrHandler = "Filename/path not viable." Then MsgBox strSaveAsErrHandler Exit Sub Else '==========Startup========== Application.ScreenUpdating = False Sheets("LoadingData").Visible = True Sheets("Launchpad").Visible = False '==========Check for/create Temp Directory========== If FileFolderExists(strFileJustPath & "\temp") = True Then 'MsgBox "temp Folder already exists." Else MkDir strFileJustPath & "\temp" 'MsgBox "temp Folder didn't exist, but it do now." End If '==========Download Section========== '=====Set up===== 'big gap for now = 169436 strQueryID = txtQueryID.Value strDLlink = "https://workbench.northgrum.com/xauth/login.aspx?&ActionPageID=37&ActionParameters=QueryID%3d" & strQueryID & "%26View%3d0%26OutputToExcel%3d1" strDLdest = strFileJustPath & "\temp\dump.xlsx" '=====Run===== 'MsgBox "cmdBigGo thinks strDLdest = " & strDLdest Dim done done = URLDownloadToFile(0, strDLlink, strDLdest, 0, 0) '==========Copy Targets from temp file========== Sheets("LoadingData").Select copyPathName = strFileJustPath & "\temp\" copyFileName = "dump.xlsx" copyTabName = "Targets" ControlFile = ActiveWorkbook.Name Workbooks.Open FileName:=copyPathName & "\" & copyFileName ActiveSheet.Name = copyTabName Sheets(copyTabName).Copy After:=Workbooks(ControlFile).Sheets(1) Windows(copyFileName).Activate ActiveWorkbook.Close SaveChanges:=False Windows(ControlFile).Activate ActiveWorkbook.Sheets("Targets").Name = "COGENT Targets" '^source: https://msdn.microsoft.com/en-us/library/office/ff194819.aspx '==========Delete Temp Directory========== On Error Resume Next Kill copyPathName & "\*.*" ' delete all files in the folder RmDir copyPathName ' delete folder On Error GoTo 0 '==========Create Userform1 Button on "Targets"========== Rows("1:1").RowHeight = 26 Dim btnCOGENT As Button Set btnCOGENT = Sheets("COGENT Targets").Buttons.Add(10.5, 4.5, 84.75, 19.5) With btnCOGENT .OnAction = "CallUserform1" .Characters.Text = "COGENT" End With With btnCOGENT.Characters(Start:=1, Length:=6).Font .Name = "Calibri" .FontStyle = "Regular" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = 1 End With Sheets("COGENT Targets").Shapes("Button 1").ScaleWidth 0.7433628319, msoFalse, _ msoScaleFromTopLeft '==========Finish up========== Worksheets("COGENT Targets").Activate Sheets("LoadingData").Visible = False Application.ScreenUpdating = True End If UserForm1.Show vbModeless End Sub Private Sub SaveAsNewName() strSaveAsErrHandler = "" On Error GoTo ErrorHandler '==========Save the file with a new name========== Dim strExpectedFileFullName As String strExpectedFileFullName = txtFilePath.Value & "\" & txtFileName & ".xlsm" ActiveWorkbook.SaveAs strExpectedFileFullName FileNameChecker_local 'get the new filename Exit Sub ErrorHandler: '==========Error Handler========== If Err.Number = 1004 Then lblSaveAsText.Caption = "That name and location didn't work... Try using 'Browse' or 'Create Outbox." lblSaveAsText.BackColor = &H8080FF strSaveAsErrHandler = "Filename/path not viable." Else MsgBox "unknown error...email Owen.Britton@NGC.com; it's probably his fault." strSaveAsErrHandler = "" End If End Sub Sub FileNameChecker_local() '==========Check Filename and SaveAs if needed========== strFileJustPath = ActiveWorkbook.Path strFileFullName = ActiveWorkbook.FullName '==========Get Filename========== Dim i As Integer Dim intBackSlash As Integer, intPoint As Integer For i = Len(strFileFullName) To 1 Step -1 If Mid$(strFileFullName, i, 1) = "." Then intPoint = i Exit For End If Next i If intPoint = 0 Then intPoint = Len(strFileFullName) + 1 For i = intPoint - 1 To 1 Step -1 If Mid$(strFileFullName, i, 1) = "\" Then intBackSlash = i Exit For End If Next i strFileName = Mid$(strFileFullName, intBackSlash + 1, intPoint - intBackSlash - 1) 'MsgBox "strFileName = " & strFileName & vbNewLine & _ "strFileJustPath = " & strFileJustPath & vbNewLine & _ "strFileFullName = " & strFileFullName & vbNewLine & _ "ran from userform2" End Sub Private Sub ValueInjector() strRawDate = Format(Date, "mm-d-yy") '==========Inject File Name========== If strFileName = "COGENT Launchpad" Then txtFileName.Value = "COGENT_Pull_" & strRawDate 'might be better to include query number\ lblSaveAsText.Caption = "Give your output a descriptive name. Here's a suggestion:" Else 'txtFileName.Value = strFileName lblSaveAsText.Caption = "This file should be named 'COGENT Launchpad.' Some features break if you rename it." lblSaveAsText.BackColor = &H8080FF 'MsgBox "Please rename this file 'COGENT Launchpad'" End If '==========Inject File Path========== Application.ScreenUpdating = False If IsEmpty(Worksheets("Hiddensheet1").Range("B6")) Then cmdCreateOutbox_click Worksheets("Hiddensheet1").Range("B6") = strFileJustPath & "\Outbox" txtFilePath.Value = Worksheets("Hiddensheet1").Range("B6") Else txtFilePath.Value = Worksheets("Hiddensheet1").Range("B6") End If Application.ScreenUpdating = True Worksheets("Launchpad").Activate End Sub Private Sub cmdBrowse_Click() FileNameChecker_local GetFolder (strFileJustPath) End Sub Private Sub cmdMakeDefault_Click() Worksheets("Hiddensheet1").Range("B6") = txtFilePath.Value imgCheckMark.Visible = True End Sub Private Sub cmdCreateOutbox_click() 'MsgBox "looking for" & strFileJustPath & "\Outbox" If FileFolderExists(strFileJustPath & "\Outbox") Then MsgBox "Outbox Folder already exists." Else MsgBox "Outbox Folder did not exist, but it does now." MkDir strFileJustPath & "\Outbox" txtFilePath.Value = strFileJustPath & "\Outbox" End If End Sub Function GetFolder(strFilePath As String) As String Dim fldr As FileDialog Dim strGetFolderOutput As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = strFilePath If .Show <> -1 Then GoTo NextCode strGetFolderOutput = .SelectedItems(1) End With NextCode: GetFolder = strGetFolderOutput txtFilePath.Value = strGetFolderOutput Set fldr = Nothing End Function Private Sub userform_terminate() Unload Me End Sub
不知怎的，隐藏的工作表被删除，并且在我检查它的存在之前被引用，并且如果不存在，则创build它。 多谢你们; 我正在狂吠完全错误的树。 修复和工作。
根本没有什么是错误的调用用户表单。