CMD/BAT - [решено] копирование столбца из excel в другой excel

[romfus]

romfus, Вы точно уверены насчёт семи столбцов? У меня токмо шесть помещаются. И — по короткому пустому столбцу между столбцами будем вставлять для наглядности, або нет?

[romfus]

romfus, я сейчас отлучён от компьютера, не могу выдать решение, но лучше написать, например, vbs- скрипт, который последовательно откроет эксел-файлы, выделит в них нужную область и напечатает выделенное. Помнится, такая возможность в экселе была.

Либо создать пустой бланк для печати столбца, настроить параметры листа для аывода, макросом в этом бланке последовательно открывать ваши файлы, забирать нужную область и сразу пускать на печать, затем очищать напечатанное и т д.....

Корёжить исходные файлы или делать кучу новых только для печати- плохая идея. Ведь цель всей возни - напечатать выделенные области из всех указанных файлов.

[Iska]

megaloman, ну, вроде бы уже решили, что корёжить не будем, сохранять не будем, будем токмо печатать. Осталось сообразить, как сие реализовать наиболее доступным образом .

[Iska]

Iska, пока я тыркал пальцем в планшет, у Вас состоялось бурное объяснение Имхо, проще и надёжнее сделать бланк и далее по тексту предыдущего поста

[megaloman]

romfus, ну, пробуйте, что получилось:



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

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Option Explicit
Const intColumns = 7
Const intRows = 56
Dim strSourceFolder
Dim objFSO
Dim objFile
Dim objExcel
Dim objSourceSheet
Dim objDestSheet
Dim objSourceRange
Dim objDestRange
If WScript.Arguments.Count = 1 Then
	strSourceFolder = WScript.Arguments.Item(0)
	Set objExcel = Nothing
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	If objFSO.FolderExists(strSourceFolder) Then
		For Each objFile In objFSO.GetFolder(strSourceFolder).Files
			Select Case LCase(objFSO.GetExtensionName(objFile.Name))
				Case "xls", "xlsx"
					If objExcel Is Nothing Then
						Set objExcel = WScript.CreateObject("Excel.Application")
					End If
					With objExcel
						With .Workbooks.Open(objFile.Path)
							Set objSourceSheet = .Worksheets.Item(1)
							Set objDestSheet = .Worksheets.Add
							If StrComp(objSourceSheet.Cells(1, 1).Value, "num", vbTextCompare) = 0 Then
								Set objSourceRange = objSourceSheet.Range(objSourceSheet.Cells(1, 1), objSourceSheet.Cells(intRows, 1))
								Set objDestRange = objDestSheet.Cells(1, 1)
								objSourceRange.Copy objDestRange
								Do Until objExcel.Intersect(objSourceSheet.UsedRange, objSourceRange) Is Nothing
									Set objSourceRange = objSourceRange.Offset(intRows, 0)
									If objDestRange.Column = intColumns Then
										objDestSheet.VPageBreaks.Add objDestRange.Offset(0, 1)
										Set objDestRange = objDestRange.Offset(intRows, 1 - intColumns)
										objDestSheet.HPageBreaks.Add objDestRange
									Else
										Set objDestRange = objDestRange.Offset(0, 1)
									End If
									objSourceRange.Copy objDestRange
								Loop
								objDestSheet.UsedRange.Columns.AutoFit
								objDestSheet.PrintOut
							Else
								WScript.Echo "Can't find [num] in A1 cell in first worksheet in [" & objFile.Name & "] workbook."
							End If
							.Close False
						End With
					End With
				Case Else
					' Nothing to do
			End Select
		Next
		objExcel.Quit
		Set objExcel = Nothing
	Else
		WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
		WScript.Quit 2
	End If
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ "
	WScript.Quit 1
End If
Set objFSO = Nothing
WScript.Quit 0

После седьмого столбца и после каждой пятьдесят шестой строки вставляются жёсткие разрывы страницы.