How Pass code to VBScript from vba macro excel

santiago carvajal 0
Viewed 62

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

vbscript vba excel
1 Answers

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
VBasic20080
Related