脚本在Citrix VDI登录下运行，但在AWS登录时出现错误。我按照堆栈溢出指南尝试了所有选项，但问题仍然出现。
代码如下:
这个特定的代码将从输入工作表中复制数据，并在具有五个单独选项卡的新工作簿中提取数据。
Dim CurBookName As String
Dim NewBookName As String
Dim sServerName As String
Private Sub CheckBox1_Change()
'If checkbox is checked, all the products in the listbox will be selected. If checkbox is unchecked
'all the products in the listbox will be deselected.
If CheckBox1.Value = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next
ElseIf CheckBox1.Value = False Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End If
End Sub
Private Sub CommandButton1_Click()
'This code creates new Workbook and adds required Worksheets to it
On Error GoTo errHandler
Dim i As Integer, j As Integer
Dim bSelFlag As Boolean
Dim sFormula As String
Dim sVersion As String
Dim sPath As String
Dim sRepVerVal As String, sComVerVal As String
bSelFlag = False
For j = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(j) = True Then
bSelFlag = True
Exit For
End If
Next j
If bSelFlag = False Then
MsgBox "Please select one or more products from the product list"
Exit Sub
End If
CurBookName = ActiveWorkbook.name
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
SetMenuParameters (i)
' 1. Create blank workbook
' 2. Copy all format to new workbook
' 3. Copy all value to new workbook
Workbooks.Add
NewBookName = ActiveWorkbook.name
Workbooks(NewBookName).Worksheets.Add().name = "Total Summary"
Workbooks(NewBookName).Worksheets.Add().name = "Flow"
Workbooks(NewBookName).Worksheets.Add().name = "Variance"
Workbooks(NewBookName).Worksheets.Add().name = "TBA"
Workbooks(NewBookName).Worksheets.Add().name = "Percentage"
Workbooks(NewBookName).Worksheets.Add().name = "Total"
Application.DisplayAlerts = False
Workbooks(NewBookName).Worksheets("sheet1").Delete
Workbooks(NewBookName).Worksheets("sheet2").Delete
Workbooks(NewBookName).Worksheets("sheet3").Delete
Application.DisplayAlerts = True
Windows(CurBookName).Activate
Application.StatusBar = "Please wait....Copy Process is in progress for the Product '" & ListBox1.List(i) & "' ..."
CopySheet "Total Input", "Total"
CopySheet "Price Input", "Percentage"
TBA_Built = False
CopySheet "TBA", "TBA"
Var_Built = False
CopySheet "Variance", "Variance"
CF_Built = False
CopySheet "Flow", "Flow"
CopySheet "Total Summary", "Total Summary"
sVersion = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
sPath = "\usershunt"
If val(Application.Version) > 11 Then
Call Hide_Rows_Snapshot(NewBookName, "Percentage")
NewBookName = "TM1 " & ListBox1.List(i) & " TBA (" & sVersion & ")_" & Format(Now(), "MMDDYYHHMMSS") & ".xlsx"
ElseIf val(Application.Version) = 11 Then
NewBookName = "TM1 " & ListBox1.List(i) & " TBA (" & sVersion & ")_" & Format(Now(), "MMDDYYHHMMSS") & ".xls"
End If
ActiveWorkbook.SaveAs filename:=sPath & Replace(NewBookName, "/", "_")
ActiveWindow.Close
End If
Next
MsgBox "Copy Process has been done successfully!" & vbCrLf & vbCrLf & "Please find the Snapshots at " & sPath
Application.StatusBar = ""
Exit Sub
errHandler:
MsgBox Err.Description
End Sub
Private Sub Worksheet_Activate()
'This code populates TBA products
Dim iMonth As Integer, iYear As Integer, sYear As Integer
Dim sMonth As String, sVersion As String, sVerFormula As String
Dim sVarVersion As String, sVarVerFormula As String
PopulateProducts
iYear = Format(Date, "yyyy")
sMonth = Format(Date, "mmm")
sMonthnum = Month(Date)
If sMonth = "Jan" Or sMonth = "Apr" Or sMonth = "Jul" Or sMonth = "Oct" Then
sMonthnum = sMonthnum + 1
sYear = iYear
ElseIf sMonth = "Mar" Or sMonth = "Jun" Or sMonth = "Sep" Then
sMonthnum = sMonthnum + 2
sYear = iYear
ElseIf sMonth = "Dec" Then
sMonthnum = sMonthnum - 10
iYear = iYear + 1
sYear = iYear
Else
sMonthnum = sMonthnum
sYear = iYear
End If
sMonth = MonthName(sMonthnum, True)
sVersion = sMonth & "_" & Mid(CStr(iYear), 3, 2) & "_Forecast"
'Setting default values to Report Parameters
Worksheets("CreateSnapshot").Cells(9, 8) = sVersion
sServerName = Worksheets("Globals").Range("Server_Name").Value
sVerFormula = "SUBNM(" & """" & sServerName & ":Version""" & "," & """" & """,""" & sVersion & """)"
Worksheets("CreateSnapshot").Cells(9, 8).Formula = "=" & sVerFormula
Worksheets("CreateSnapshot").Cells(10, 8) = Format(Date, "yyyy") - 1
'Setting default values to Variance Parameters
iMonth = Month(Now)
iYear = Year(Now)
iYear = Format(Date, "yyyy")
iMonth = sMonthnum
If iMonth = 2 Then
If iYear <> sYear Then
iMonth = 11
Else
iMonth = 11
iYear = iYear - 1
End If
Else
iMonth = iMonth - 3
End If
sVarVersion = MonthName(iMonth, True) & "_" & Mid(CStr(iYear), 3, 2) & "_Forecast"
Worksheets("CreateSnapshot").Cells(9, 11) = sVarVersion
sVarVerFormula = "SUBNM(" & """" & sServerName & ":Version""" & "," & """" & """,""" & sVarVersion & """)"
Worksheets("CreateSnapshot").Cells(9, 11).Formula = "=" & sVarVerFormula
End Sub
Public Sub PopulateProducts()
'The listbox is populated with Products from TBA_Products subset
Dim SubsetSize As Integer, i As Integer
Dim ElName As String
SubsetSize = Application.Run("SUBSIZ", ThisWorkbook.Worksheets(GLOBALS).Range("Server_Name") & ":Product", "TBA_Products")
ListBox1.Clear
i = 1
While i <= SubsetSize
ElName = Application.Run("SUBNM", ThisWorkbook.Worksheets(GLOBALS).Range("Server_Name") & ":Product", "TBA_Products", i, "Description")
ListBox1.AddItem (ElName)
i = i + 1
Wend
ListBox1.Height = 220
ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub CopySheet(SourceSheetName As String, TargetSheetName As String)
'This code copies all the data from source workbook to target workbook
Dim ProdName As String
On Error Resume Next
Application.ScreenUpdating = False
Workbooks(CurBookName).Worksheets(SourceSheetName).Activate
Workbooks(CurBookName).Worksheets(SourceSheetName).Cells.Copy
Workbooks(NewBookName).Worksheets(TargetSheetName).Activate
Workbooks(NewBookName).Worksheets(TargetSheetName).Cells(1, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(NewBookName).Worksheets(TargetSheetName).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Workbooks(CurBookName).Worksheets(SourceSheetName).Range("B2").CopyPicture xlScreen, xlBitmap
ProdName = Workbooks(CurBookName).Worksheets(MENU).Range("Input_Product").Value
Workbooks(CurBookName).Worksheets(SourceSheetName).Shapes(ProdName).Copy
Workbooks(NewBookName).Worksheets(TargetSheetName).Range("B1:B3").PasteSpecial
Worksheets(TargetSheetName).Shapes(ProdName).Left = Worksheets(TargetSheetName).Columns("B").Left
Worksheets(TargetSheetName).Shapes(ProdName).Top = Worksheets(TargetSheetName).Rows(1).Top
Worksheets(TargetSheetName).Shapes(ProdName).Height = Worksheets(TargetSheetName).Rows(4).Top - Worksheets(TargetSheetName).Rows(1).Top
ActiveWindow.Zoom = 70
Workbooks(NewBookName).Worksheets(TargetSheetName).Columns("A").Hidden = True
Workbooks(NewBookName).Worksheets(TargetSheetName).Range("E1").Select
Application.ScreenUpdating = True
End Sub
Public Sub SetMenuParameters(iVal As Integer)
'Input parameters and Report parameters are being set here
'Input Parameters
sServerName = Worksheets("Globals").Range("Server_Name").Value
Workbooks(CurBookName).Worksheets("Menu").Range("Input_Product").Value = ListBox1.List(iVal)
sFormula = "SUBNM(" & """" & sServerName & ":Product""" & "," & """TBA_Products""" & "," & iVal + 1 & "," & """Description""" & ")"
Workbooks(CurBookName).Worksheets("Menu").Cells(8, 4).Formula = "=" & sFormula
Workbooks(CurBookName).Worksheets("Menu").Cells(5, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(5, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(6, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(6, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(7, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(7, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(9, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(10, 8).Value
'Report Parameters
Workbooks(CurBookName).Worksheets("Menu").Range("Report_Product").Value = ListBox1.List(iVal)
sFormula = "SUBNM(" & """" & sServerName & ":Product""" & "," & """TBA_Products""" & "," & iVal + 1 & ", " & """Description""" & " )"
Workbooks(CurBookName).Worksheets("Menu").Cells(19, 4).Formula = "=" & sFormula
Workbooks(CurBookName).Worksheets("Menu").Cells(16, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(16, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(17, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(17, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(18, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(18, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(20, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(10, 8).Value
'Variance Parameters
Var_Built = True
Workbooks(CurBookName).Worksheets("Variance").Cells(4, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(4, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 11).Formula
Workbooks(CurBookName).Worksheets("Variance").Cells(5, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(5, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 11).Formula
Workbooks(CurBookName).Worksheets("Variance").Cells(6, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(6, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 11).Formula
End Sub
Private Sub Hide_Rows_Snapshot(NewBookName As String, TargetSheetName As String)
Dim UsedRows As Integer
Dim UseRange As String
Workbooks(NewBookName).Activate
With ActiveWorkbook
UsedRows = .Worksheets(TargetSheetName).UsedRange.Rows.Count
UseRange = "A1:A" & Trim(str(UsedRows))
For Each c In .Worksheets(TargetSheetName).Range(UseRange).Cells
If c.Value = "hide" Then
.Worksheets(TargetSheetName).Rows(c.Row).Hidden = True
Else
.Worksheets(TargetSheetName).Rows(c.Row).Hidden = False
End If
Next
End With
End Sub
所有Subscript Out of Range的意思是你的数组没有你正在请求的成员。
dim v(5) as variant
v(0) = 'dog'
v(1) = 'cat'
v(2) = 'fish'
v(3) = 42
v(4) = 3.14
debug.print v(4) // Output is 3.14
debug.print v(5) //Throws Subscript out of range error.