[Maza11]

А если у меня есть код для макроса делающий разбивающий одну большую накладную на отдельные и размещает их с номерами 01, 02, 03 .. в той же папке, помогите переделать ее на скрипт VBS т.к. у них отличается синтаксис чуть-чуть, всякие WScript добавляются, чтобы работало перетягивание файла из провдника, и накладные создавались в той же папке где файл оригинал лежит

Код:

Sub Эпицентр()
    Dim fn As String, Sh As Worksheet, Sh_out As Worksheet
    Dim Fout As String, Cl As Collection
    fn = Get_FileName
    If fn = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    Fout = ThisWorkbook.Path
    Set Cl = New Collection
    Set Sh = Workbooks.Open(fn).Worksheets(1)
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    dx = Sh.Range("A1:A" & LastRow)
    ss = "1:"
    For n = 1 To LastRow
        If InStr(1, dx(n, 1), "Автор друку:", vbTextCompare) > 0 Then
            ss = ss & (n - 1)
            Cl.Add ss
            ss = (n + 1) & ":"
        End If
    Next
    For n = 1 To Cl.Count
        ThisWorkbook.Worksheets("Документ").Copy
        Set Sh_out = ActiveSheet
        Sh.Rows(Cl.Item(n)).Copy Sh_out.Range("A1")
        For Each hp In Sh_out.Shapes
            hp.Delete
        Next
        Set xx = Sh_out.Cells.Find("%!", , , xlPart)
        If Not xx Is Nothing Then xx.Value = ""
     
        Sh_out.SaveAs Filename:=Fout & "\" & n & ".xls", FileFormat:=xlExcel8
        Sh_out.Parent.Close (False)
    Next

Sh.Parent.Close (False)
  Application.ScreenUpdating = True

MsgBox "Game Over"
End Sub








Function Get_FileName(Optional ByVal Title As String = "Выберите файл для обработки", _
                      Optional ByVal FilterDescription As String = "Файлы Excel", _
                      Optional ByVal FilterExtention As String = "*.xls*") As String
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)    '
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        Get_FileName = .SelectedItems(1)
    End With



End Function

накладные должны быть отдельными файлами, без логотипа, без строки с процентами и автора друку и иметь вид по ширине листа, печатать их будет отдельно