[Iska]

1. нельзя перетащить один файл, работает только если папку перетаскивать »

Не было заказано. Было:

Можно ли как то его применить для всех документов в конкретной папке, »

Если хотите и так, и этак, то вот:

Скрытый текст

Код:

Option Explicit

Dim strSourceFileSystemObject

Dim objFile
Dim objExcel


If WScript.Arguments.Count = 1 Then
	strSourceFileSystemObject = WScript.Arguments.Item(0)
	
	With WScript.CreateObject("Scripting.FileSystemObject")
		If .FolderExists(strSourceFileSystemObject) Then
			Set objExcel = Nothing
			
			For Each objFile In .GetFolder(strSourceFileSystemObject).Files
				Select Case LCase(.GetExtensionName(objFile.Name))
					Case "xls", "xlsx"
						If objExcel Is Nothing Then
							Set objExcel = WScript.CreateObject("Excel.Application")
						End If
						
						WorkingWithWorkbook objExcel, objFile
					Case Else
						' Nothing to do
				End Select
			Next
			
			If Not objExcel Is Nothing Then
				objExcel.Quit
				Set objExcel = Nothing
			End If
		ElseIf .FileExists(strSourceFileSystemObject) Then
			Set objFile = .GetFile(strSourceFileSystemObject)
			
			Select Case LCase(.GetExtensionName(objFile.Name))
				Case "xls", "xlsx"
					With WScript.CreateObject("Excel.Application")
						WorkingWithWorkbook .Application, objFile
						
						.Quit
					End With
				Case Else
					WScript.Echo "Source file [" & strSourceFileSystemObject & "] probably has not an Excel Workbook."
			End Select
			
			Set objFile = Nothing
		Else
			WScript.Echo "Can't find source file or source folder [" & strSourceFileSystemObject & "]."
			WScript.Quit 2
		End If
	End with
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file or source folder>"
	WScript.Quit 1
End If

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub WorkingWithWorkbook(objExcel, objFile)
	WScript.Echo objFile.Path
	
	With objExcel
		With .Workbooks.Open(objFile.Path)
			With .Worksheets.Item(1)
				.Shapes.Item("Picture -767").Delete
				.Range("H4:I6").Select
				objExcel.Selection.ClearContents
				.Range("A1").Select
				
				objExcel.Union(.Rows(.UsedRange.Rows.Count).EntireRow, .Rows(.UsedRange.Rows.Count -1).EntireRow).Delete
				
				With .PageSetup
					.Zoom = False
					.FitToPagesWide = 1
				End With
				
				.PrintOut ,, 3
			End With
			
			.Save
			.Close
		End With
	End With
End Sub
'=============================================================================

Я, кстати, в предыдущем коде забыл сделать выход из Excel и сослепу оставил после копирования куска кода вместо очистки объекта — его создание.

2. не выставляет печать по ширине документа (фото распечатанного документа https://www.dropbox.com/s/wxfgrma9oe...41.01.jpg?dl=0 ) »

Я вроде как выставляю:

Код:

.PageSetup.FitToPagesWide = 1

Давайте попробуем добавить ещё и рекомендуемое «.Zoom = False».