Попытка преобразовать макрос Excel в автономный VBScript

Question

У меня есть следующий макрос, который отлично работает в Excel, но я абсолютно ничего не знаю о vbscripting, кроме того, что у него общего с vba. Я попробовал несколько вещей и больше не получаю ошибки, но это все еще не работает. Цель кода - открыть лист Excel, полный данных проверки, и повернуть ячейки красным, желтым или зеленым в зависимости от того, находится ли объект вне допуска, с использованием> 80% его допуска или допуска. В Excel это будет l oop для всех файлов, выбранных в 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

Answer 1

VBScript не имеет хост-приложения и не знает об этих объектах Excel, на которые вы ссылаетесь, и других проблемах

• Основная процедура скрипта не инкапсулирована в Sub - удалите его
• Именованные константы не известны msoFileDialogFilePicker, xlNone - вместо них используйте их значения
• Application не известно - используйте уже созданный экземпляр xl
• Cells неизвестно - используйте блок With, который вы уже создали (это также проблема в вашем VBA)
• Вы должны закрыть экземпляр xl, прежде чем получить доступ это - Set xl ... идет раньше Set fDialog ...
• Вы не можете Quit рабочую книгу - Close это
• Возможно, вы захотите Quit xl объект на end

Я скажу вам на слово, что макрос , который отлично работает в Excel , так как я не могу видеть ваш лист (но выглядит он немного fr agile мне)

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