AndVGri
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Public Sub SetPageA4()
On Error GoTo errHandle
Dim fso As New Scripting.FileSystemObject
Dim pFile As Scripting.File, pFolder As Scripting.Folder
Dim pSheet As Excel.Worksheet, pBook As Excel.Workbook
Dim pDialog As Office.FileDialog, sPath As String
Set pDialog = Application.FileDialog(msoFileDialogFolderPicker)
If pDialog.Show Then
Application.ScreenUpdating = False
sPath = pDialog.SelectedItems(1&)
Set pFolder = fso.GetFolder(sPath)
For Each pFile In pFolder.Files
If LCase$(fso.GetExtensionName(pFile.Name)) = "xls" Then
Set pBook = Workbooks.Open(pFile.Path)
For Each pSheet In pBook.Worksheets
pSheet.PageSetup.PaperSize = xlPaperA4
Next pSheet
pBook.Close SaveChanges:=True
End If
Next pFile
Application.ScreenUpdating = True
End If
Exit Sub
errHandle:
MsgBox Err.Description, Err.Source
Application.ScreenUpdating = True
End Sub
|
