我的工作表上有一个CMD按钮，代码如下：
Private Sub cmdBlastoff_Click()
UserForm2.Show vbModeless 'launch gateway userform
End Sub
此代码工作了很长时间，但现在正在生成＆＃34;错误9：下标超出范围。＆＃34;
我要调用的用户窗体（UserForm2）位于同一工作簿中。
我会将下面的用户表单的完整代码放在相关的位置，但其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
正如我之前所说，直到最近才开始工作，我的想法不合时宜。 到目前为止，我已经尝试过：
ActiveWorkbook.UserForm2.show（因为原因而无法工作
现在很明显）我认为更明确的呼叫是最可能的解决方案，
但不知道该怎么做vbModeless ActiveWorkbook设置为我所有的东西
存储在，这是呼叫按钮所在的位置（这不应该是
必要的，我知道）还有其他想法吗？
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
答案 0 :(得分：0)
不知何故隐藏的工作表被删除了，在我检查它的存在之前它会被引用并在缺少时创建它。多谢你们;我正在咆哮着完全错误的树。固定和工作。
根本没有调用userform。