How Pass code to VBScript from vba macro excel-CodePudding

I have this code in a Excel Macro, so, i need execute this code in a .vbs (scripts), i dont know the way to can pass, i'm amateur in this area, so, i need to help for can do that.

Sub RemoveHiddenRows()
    Dim xRow As Range
    Dim xRg As Range
    Dim xRows As Range
    On Error Resume Next
    Set xRows = Intersect(ActiveSheet.Range("A:A").EntireRow, ActiveSheet.UsedRange)
    If xRows Is Nothing Then Exit Sub
        For Each xRow In xRows.Columns(1).Cells
            If xRow.EntireRow.Hidden Then
                If xRg Is Nothing Then
                    Set xRg = xRow
                Else
                    Set xRg = Union(xRg, xRow)
                End If
            End If
        Next
        If Not xRg Is Nothing Then
            
        Else
            
        End If
    End Sub

I try called the excel that i will use for this

set app = CreateObject("Excel.Application")
app.Visible = True
Set objWB = app.Workbooks.Open("C:\REPORTE_DE_CREDITOS_MODERNO\RPT\FACTURAS.XLS")
set objWS = app.ActiveWorkBook.WorkSheets(1)

But, i dont know how continue

CodePudding user response：

Delete Hidden Rows

This will delete hidden rows of the used range.
It will check if the file is open in the current instance of Excel (for VBScript: if any instance is open) and exit if the file is open.
If the file isn't open, it will create a new instance of Excel, where it will open the file, do the job and save and close the file, closing the instance afterward.

VBA

Option Explicit

Sub DeleteHiddenRowsInFacturas()

    ' Define constants.
    Const FolderPath As String = "C:\REPORTE_DE_CREDITOS_MODERNO\RPT"
    Const Filename As String = "FACTURAS.XLS"
    Const WorksheetID As Variant = 1 ' allowing names and indexes

    DeleteHiddenRows FolderPath, Filename, WorksheetID

End Sub

Sub DeleteHiddenRows( _
        ByVal FolderPath As String, _
        ByVal Filename As String, _
        ByVal WorksheetID As Variant)
    
    ' Define constants.
    Const ProcName As String = "DeleteHiddenRows"
    
    ' Declare variables.
    Dim wb As Workbook
    
    ' Attempt to reference the workbook ('wb').
    On Error Resume Next
        Set wb = Workbooks(Filename)
    On Error GoTo 0
    
    ' Check if a workbook with the same name is open in the current application.
    If Not wb Is Nothing Then ' a workbook with the same name is open
        ' Check if the paths of the open workbook and the workbook to be opened
        ' are the same.
        If StrComp(FolderPath, wb.Path, vbTextCompare) = 0 Then ' the same
            MsgBox "The file is open in the current instance of Excel." & vbLf _
                & "Close it and try again.", vbCritical, ProcName
            Exit Sub
        Else ' the paths are not the same
            Set wb = Nothing ' reset to reuse in the continuation of the code
        End If
    'Else ' no workbook with the same name is open; do nothing
    End If
    
    ' Store the file path in a variable ('FilePath').
    Dim FilePath As String
    FilePath = FolderPath & Application.PathSeparator & Filename
    
    ' Using Dir, check if the file exists.
    If Len(Dir(FilePath)) = 0 Then
        MsgBox "The file doesn't exist.", vbCritical, ProcName
        Exit Sub
    End If
    
    ' Declare variables.
    Dim Success As Boolean
    
    ' Create and reference a new instance of Excel.
    Dim app As Excel.Application: Set app = New Excel.Application
    'app.Visible = True ' out-comment when finished developing
    
    ' Open and reference the workbook ('wb').
    Set wb = app.Workbooks.Open(FilePath)
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = wb.Worksheets(WorksheetID)
    ' Reference all entire rows of the used range ('rg').
    Dim rg As Range: Set rg = ws.UsedRange.EntireRow
        
    ' Declare variables.
    Dim urg As Range
    Dim rrg As Range
    
    ' Loop through each row ('rrg') of the range...
    For Each rrg In rg.Rows
        ' Check if the current row is hidden.
        If rrg.Hidden = True Then ' the row is hidden
            ' Combine the row into a union range ('urg').
            If urg Is Nothing Then ' the first row
                Set urg = rrg
            Else ' all but the first row
                Set urg = app.Union(urg, rrg)
            End If
        'Else ' the row is not hidden; do nothing
        End If
    Next rrg
    
    ' Validate the union range.
    If Not urg Is Nothing Then ' the range is 'valid'
        urg.Delete xlShiftUp
        Success = True
    'Else ' the range is 'invalid'; do nothing
    End If
    
    ' Close the workbook.
    wb.Close SaveChanges:=Success
    
    ' Quit the new instance of Excel.
    app.Quit
        
    ' Inform.
    If Success Then
        MsgBox "Hidden rows deleted.", vbInformation, ProcName
    Else
        MsgBox "No hidden rows. No action taken.", vbExclamation, ProcName
    End If

End Sub

VBScript

Copy this code into a new text file.
Adjust the values in the constants section.
Save the file with a .vbs extension.
Double-click to run it.

Option Explicit
 
DeleteHiddenRowsInFacturas
 
Sub DeleteHiddenRowsInFacturas()

    ' Define constants.
    Const FolderPath = "C:\REPORTE_DE_CREDITOS_MODERNO\RPT"
    Const Filename = "FACTURAS.XLS"
    Const WorksheetID = 1

    DeleteHiddenRows FolderPath, Filename, WorksheetID

End Sub
 
Sub DeleteHiddenRows( _
        ByVal FolderPath, _
        ByVal Filename, _
        ByVal WorksheetID)

    ' Define constants.
    Const ProcName = "DeleteHiddenRows"
    
    ' Declare and initialize variables.
    Dim app: Set app = Nothing
    Dim wb: Set wb = Nothing

    ' Attempt to reference an existing instance of Excel.
    On Error Resume Next
        Set app = GetObject(, "Excel.Application")
    On Error GoTo 0

    ' Check if an instance of Excel was referenced.
    If Not app Is Nothing Then ' an instance of Excel is open
        ' Attempt to reference the workbook ('wb').
        On Error Resume Next
            Set wb = app.Workbooks(Filename)
        On Error GoTo 0
        ' Check if a workbook with the same name is open
        ' in the current application.
        If Not wb Is Nothing Then ' a workbook with the same name is open
            ' Check if the paths of the open workbook and the workbook
            ' to be opened are the same. Use '1' instead of 'vbTextCompare'.
            If StrComp(FolderPath, wb.Path, 1) = 0 Then ' the same
                MsgBox "The file is open in the current instance of Excel." _
                    & vbLf & "Close it and try again.", vbCritical, ProcName
                Exit Sub
            Else ' the paths are not the same
                Set wb = Nothing ' reset to reuse in the continuation
            End If
        'Else ' no workbook with the same name is open; do nothing
        End If
        Set app = Nothing ' reset to reuse in the continuation of the code
    'Else ' no instance of is Excel open; do nothing
    End If
    
    ' Store the file path in a variable ('FilePath').
    ' To simplify, I'm using "\" instead of e.g. 'app.PathSeparator',
    ' since I've reset the 'app' variable and I don't know if there will
    ' be an open Excel instance.
    Dim FilePath: FilePath = FolderPath & "\" & Filename
    
    ' Using the FileSystemObject object, check if the file exists.
    ' There is no Dir in VBScript.
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(FilePath) Then ' the file doesn't exist
            MsgBox "The file doesn't exist.", vbCritical, ProcName
            Exit Sub
        'Else ' the file exists; do nothing
        End If
    End With
    
    ' Declare and initialize variables.
    Dim Success: Success = False
    
    ' Create and reference a new instance of Excel.
    Set app = CreateObject("Excel.Application")
    'app.Visible = True ' out-comment when finished developing
    
    ' Open and reference the workbook ('wb').
    Set wb = app.Workbooks.Open(FilePath)
    ' Reference the worksheet ('ws').
    Dim ws: Set ws = wb.Worksheets(WorksheetID)
    ' Reference all entire rows of the used range ('rg').
    Dim rg: Set rg = ws.UsedRange.EntireRow
        
    ' Declare and initialize variables.
    Dim urg: Set urg = Nothing
    Dim rrg: Set rrg = Nothing
    
    ' Loop through each row ('rrg') of the range...
    For Each rrg In rg.Rows
        ' Check if the current row is hidden.
        If rrg.Hidden = True Then ' the row is hidden
            ' Combine the row into a union range ('urg').
            If urg Is Nothing Then ' the first row
                Set urg = rrg
            Else ' all but the first row
                Set urg = app.Union(urg, rrg)
            End If
        'Else ' the row is not hidden; do nothing
        End If
    Next
    
    ' Validate the union range.
    If Not urg Is Nothing Then ' the range is 'valid'
        ' Delete the range. Use '-4162' instead of 'xlShiftUp'.
        urg.Delete -4162
        Success = True
    'Else ' the range is 'invalid'; do nothing
    End If
    
    ' Close the workbook.
    wb.Close Success
    
    ' Quit the new instance of Excel.
    app.Quit
        
    ' Inform.
    If Success Then
        MsgBox "Hidden rows deleted.", vbInformation, ProcName
    Else
        MsgBox "No hidden rows. No action taken.", vbExclamation, ProcName
    End If

End Sub