尝试将 Excel 宏转换为独立的 VBScript
Trying to convert an Excel Macro over to standalone VBScript
我有以下在 Excel 中完美运行的宏，但我对 vbscripting 除了它与 vba 的共同点外一无所知。我已经尝试了一些东西，不再出现错误，但它仍然无法正常工作。该代码的目的是打开一个充满检查数据的 excel sheet 并根据特征是否超出公差将单元格变为红色、琥珀色或绿色，使用其 > 80%宽容，或宽容。在 excel 内，这将循环查找在 fDialog 中选择的所有文件，如果可能，我想保留该功能。
'#================================================================================
'# MakeRAG.vbs |
'#--------------------------------------------------------------------------------
'# |
'# Function:- |
'# Script will convert standard crystal reports in .xlsx format to RAG Charts|
'# Parameters:- |
'# none |
'# Returns:- |
'# nothing |
'#================================================================================
'# +---------+----------+---------------------------------------+----------------+
'# | Version | Date | Changes | By |
'# | 1.00 | 11/02/20 |First Release | -------------- |
'# | | | | |
'# | | | | |
'# +---------+----------+---------------------------------------+----------------+
'#================================================================================
Option Explicit
Sub Main()
'
Dim i 'As Integer
Dim j 'As Integer
Dim nominal 'As Double
Dim upperTol 'As Double
Dim lowerTol 'As Double
Dim upperAmber 'As Double
Dim lowerAmber 'As Double
Dim amberPercent 'As Double
Dim fDialog 'As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Dim thing 'As Variant
Dim xl 'As Excel.Application
Dim ragChart 'As Excel.Workbook
amberPercent = 0.8 'Feature will show as amber if exceeding this percent of tolerance
Set xl = CreateObject("Excel.Application")
With fDialog
.AllowMultiSelect = True
.Title = "Select files to make into RAG Charts"
.InitialFileName = "C:\"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
End With
If fDialog.Show = -1 Then
'Loop through all files selected in the File Open Dialog
For Each thing In fDialog.SelectedItems
'Open Workbook
Set ragChart = xl.Workbooks.Open(thing)
With ragChart.Sheets(1)
'Loop through all columns starting at column 5
For i = 5 To Application.WorksheetFunction.CountA(.Range("A3").EntireRow)
nominal = Cells(5, i).Value
upperTol = Cells(4, i).Value
lowerTol = Cells(6, i).Value
upperAmber = nominal + ((upperTol - nominal) * amberPercent)
lowerAmber = nominal - ((nominal - lowerTol) * amberPercent)
'Loop through all rows in current column
For j = 7 To Application.WorksheetFunction.CountA(.Range("B7").EntireColumn) + 7
If Cells(j, i).Value = "" Then
Cells(j, i).Interior.Color = xlNone
ElseIf Cells(j, i).Value > upperTol Or Cells(j, i).Value < lowerTol Then
Cells(j, i).Interior.Color = RGB(255, 0, 0)
ElseIf Cells(j, i).Value > upperAmber Or Cells(j, i).Value < lowerAmber Then
Cells(j, i).Interior.Color = RGB(255, 191, 0)
Else
Cells(j, i).Interior.Color = RGB(0, 255, 0)
End If
Next' j
Next' i
End With
'Save and close Workbook
ragChart.Save
ragChart.Quit
Next' thing
End If
End Sub
VBScript 没有宿主应用程序，并且不知道您正在引用的这些 Excel 对象，以及其他问题
- 脚本的主例程未封装在
Sub - 删除它
- 命名常量未知
msoFileDialogFilePicker，xlNone - 请改用它们的值
Application 未知 - 使用您已经创建的 xl 实例 Cells 未知 - 使用您已经创建的 With 块（这在您的 VBA 中也是一个问题）- 您必须先创建
xl 实例才能访问它 - Set xl ... 在 Set fDialog ... 之前
- 你不能
Quit 工作簿 - Close 它
- 您可能想要
Quit 最后的 xl 对象
我相信你的话 宏在 Excel 中完美运行，因为我看不到你的 sheet（但它在我看来有点脆弱）
Option Explicit
Dim i 'As Integer
Dim j 'As Integer
Dim nominal 'As Double
Dim upperTol 'As Double
Dim lowerTol 'As Double
Dim upperAmber 'As Double
Dim lowerAmber 'As Double
Dim amberPercent 'As Double
Dim fDialog 'As FileDialog
Dim thing 'As Variant
Dim xl 'As Excel.Application
Dim ragChart 'As Excel.Workbook
amberPercent = 0.8 'Feature will show as amber if exceeding this percent of tolerance
Set xl = CreateObject("Excel.Application")
Set fDialog = xl.FileDialog(3)
With fDialog
.AllowMultiSelect = True
.Title = "Select files to make into RAG Charts"
.InitialFileName = "C:\"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
End With
If fDialog.Show = -1 Then
'Loop through all files selected in the File Open Dialog
For Each thing In fDialog.SelectedItems
'Open Workbook
Set ragChart = xl.Workbooks.Open(thing)
With ragChart.Sheets(1)
'Loop through all columns starting at column 5
For i = 5 To xl.WorksheetFunction.CountA(.Range("A3").EntireRow)
nominal = .Cells(5, i).Value
upperTol = .Cells(4, i).Value
lowerTol = .Cells(6, i).Value
upperAmber = nominal + ((upperTol - nominal) * amberPercent)
lowerAmber = nominal - ((nominal - lowerTol) * amberPercent)
'Loop through all rows in current column
For j = 7 To xl.WorksheetFunction.CountA(.Range("B7").EntireColumn) + 7
If .Cells(j, i).Value = "" Then
.Cells(j, i).Interior.Color = -4142
ElseIf .Cells(j, i).Value > upperTol Or .Cells(j, i).Value < lowerTol Then
.Cells(j, i).Interior.Color = RGB(255, 0, 0)
ElseIf .Cells(j, i).Value > upperAmber Or .Cells(j, i).Value < lowerAmber Then
.Cells(j, i).Interior.Color = RGB(255, 191, 0)
Else
.Cells(j, i).Interior.Color = RGB(0, 255, 0)
End If
Next ' j
Next ' i
End With
'Save and close Workbook
ragChart.Close True
Next ' thing
End If
xl.Quit
我有以下在 Excel 中完美运行的宏，但我对 vbscripting 除了它与 vba 的共同点外一无所知。我已经尝试了一些东西，不再出现错误，但它仍然无法正常工作。该代码的目的是打开一个充满检查数据的 excel sheet 并根据特征是否超出公差将单元格变为红色、琥珀色或绿色，使用其 > 80%宽容，或宽容。在 excel 内，这将循环查找在 fDialog 中选择的所有文件，如果可能，我想保留该功能。
'#================================================================================
'# MakeRAG.vbs |
'#--------------------------------------------------------------------------------
'# |
'# Function:- |
'# Script will convert standard crystal reports in .xlsx format to RAG Charts|
'# Parameters:- |
'# none |
'# Returns:- |
'# nothing |
'#================================================================================
'# +---------+----------+---------------------------------------+----------------+
'# | Version | Date | Changes | By |
'# | 1.00 | 11/02/20 |First Release | -------------- |
'# | | | | |
'# | | | | |
'# +---------+----------+---------------------------------------+----------------+
'#================================================================================
Option Explicit
Sub Main()
'
Dim i 'As Integer
Dim j 'As Integer
Dim nominal 'As Double
Dim upperTol 'As Double
Dim lowerTol 'As Double
Dim upperAmber 'As Double
Dim lowerAmber 'As Double
Dim amberPercent 'As Double
Dim fDialog 'As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Dim thing 'As Variant
Dim xl 'As Excel.Application
Dim ragChart 'As Excel.Workbook
amberPercent = 0.8 'Feature will show as amber if exceeding this percent of tolerance
Set xl = CreateObject("Excel.Application")
With fDialog
.AllowMultiSelect = True
.Title = "Select files to make into RAG Charts"
.InitialFileName = "C:\"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
End With
If fDialog.Show = -1 Then
'Loop through all files selected in the File Open Dialog
For Each thing In fDialog.SelectedItems
'Open Workbook
Set ragChart = xl.Workbooks.Open(thing)
With ragChart.Sheets(1)
'Loop through all columns starting at column 5
For i = 5 To Application.WorksheetFunction.CountA(.Range("A3").EntireRow)
nominal = Cells(5, i).Value
upperTol = Cells(4, i).Value
lowerTol = Cells(6, i).Value
upperAmber = nominal + ((upperTol - nominal) * amberPercent)
lowerAmber = nominal - ((nominal - lowerTol) * amberPercent)
'Loop through all rows in current column
For j = 7 To Application.WorksheetFunction.CountA(.Range("B7").EntireColumn) + 7
If Cells(j, i).Value = "" Then
Cells(j, i).Interior.Color = xlNone
ElseIf Cells(j, i).Value > upperTol Or Cells(j, i).Value < lowerTol Then
Cells(j, i).Interior.Color = RGB(255, 0, 0)
ElseIf Cells(j, i).Value > upperAmber Or Cells(j, i).Value < lowerAmber Then
Cells(j, i).Interior.Color = RGB(255, 191, 0)
Else
Cells(j, i).Interior.Color = RGB(0, 255, 0)
End If
Next' j
Next' i
End With
'Save and close Workbook
ragChart.Save
ragChart.Quit
Next' thing
End If
End Sub
VBScript 没有宿主应用程序，并且不知道您正在引用的这些 Excel 对象，以及其他问题
- 脚本的主例程未封装在
Sub- 删除它 - 命名常量未知
msoFileDialogFilePicker，xlNone- 请改用它们的值 Application未知 - 使用您已经创建的xl实例Cells未知 - 使用您已经创建的With块（这在您的 VBA 中也是一个问题）- 您必须先创建
xl实例才能访问它 -Set xl ...在Set fDialog ... 之前
- 你不能
Quit工作簿 -Close它 - 您可能想要
Quit最后的xl对象
我相信你的话 宏在 Excel 中完美运行，因为我看不到你的 sheet（但它在我看来有点脆弱）
Option Explicit
Dim i 'As Integer
Dim j 'As Integer
Dim nominal 'As Double
Dim upperTol 'As Double
Dim lowerTol 'As Double
Dim upperAmber 'As Double
Dim lowerAmber 'As Double
Dim amberPercent 'As Double
Dim fDialog 'As FileDialog
Dim thing 'As Variant
Dim xl 'As Excel.Application
Dim ragChart 'As Excel.Workbook
amberPercent = 0.8 'Feature will show as amber if exceeding this percent of tolerance
Set xl = CreateObject("Excel.Application")
Set fDialog = xl.FileDialog(3)
With fDialog
.AllowMultiSelect = True
.Title = "Select files to make into RAG Charts"
.InitialFileName = "C:\"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
End With
If fDialog.Show = -1 Then
'Loop through all files selected in the File Open Dialog
For Each thing In fDialog.SelectedItems
'Open Workbook
Set ragChart = xl.Workbooks.Open(thing)
With ragChart.Sheets(1)
'Loop through all columns starting at column 5
For i = 5 To xl.WorksheetFunction.CountA(.Range("A3").EntireRow)
nominal = .Cells(5, i).Value
upperTol = .Cells(4, i).Value
lowerTol = .Cells(6, i).Value
upperAmber = nominal + ((upperTol - nominal) * amberPercent)
lowerAmber = nominal - ((nominal - lowerTol) * amberPercent)
'Loop through all rows in current column
For j = 7 To xl.WorksheetFunction.CountA(.Range("B7").EntireColumn) + 7
If .Cells(j, i).Value = "" Then
.Cells(j, i).Interior.Color = -4142
ElseIf .Cells(j, i).Value > upperTol Or .Cells(j, i).Value < lowerTol Then
.Cells(j, i).Interior.Color = RGB(255, 0, 0)
ElseIf .Cells(j, i).Value > upperAmber Or .Cells(j, i).Value < lowerAmber Then
.Cells(j, i).Interior.Color = RGB(255, 191, 0)
Else
.Cells(j, i).Interior.Color = RGB(0, 255, 0)
End If
Next ' j
Next ' i
End With
'Save and close Workbook
ragChart.Close True
Next ' thing
End If
xl.Quit