#1
|
|||
|
|||
Resize Paper for Multiple Files
Is there a way that I can resize the paper size of multiple files without manually doing it for each file ? |
#2
|
||||
|
||||
Yes, with a macro that runs through a folder of documents.
What paper size are you trying to adjust to?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
I want a custom size of 8.5" x 15". Weird size, but it will be converted to PDF for view on iPads not for printing
|
#4
|
||||
|
||||
Try the following macro
Code:
Sub BatchPageSizer() Dim sPath As String, aSect As Section, aDoc As Document, iCounter As Integer Dim oFSO As Object, oFolder As Object, oFile As Object sPath = SelectFolder("Select folder for page sizing") Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(sPath) For Each oFile In oFolder.files If Left(oFile.Type, 14) = "Microsoft Word" And Left(oFile.Name, 1) <> "~" Then Set aDoc = Documents.Open(FileName:=oFile.Path, Visible:=True, AddToRecentFiles:=False) iCounter = iCounter + 1 For Each aSect In aDoc.Sections aSect.PageSetup.PageWidth = InchesToPoints(15) aSect.PageSetup.PageHeight = InchesToPoints(8.5) Next aSect aDoc.Close SaveChanges:=True End If Next MsgBox "Docs processed: " & iCounter, vbOKOnly, "Macro Finished" End Sub '=========================================================== Function SelectFolder(Optional sTitle As String = "Select a Folder") As String Dim diaFolder As FileDialog ' Open the file dialog Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker) With diaFolder .AllowMultiSelect = False .Title = sTitle .Show SelectFolder = .SelectedItems(1) End With Set diaFolder = Nothing End Function
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Gave me an error with:
Function SelectFolder(Optional sTitle As String = "Select a Folder") As String |
#6
|
||||
|
||||
Not sure why that would error, perhaps an issue with the copy paste or a missing reference
Try removing that function and replace the sPath = SelectFolder("Select folder for page sizing") with sPath = "C:\My Files" where the path is to wherever you have put your Word documents.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
Now says 0 files processed, seems the macro is working but it didn't do anything
|
#8
|
||||
|
||||
Do you have Word documents in the path you pointed it at?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
Yes, I have several word documents in the folder
|
#10
|
|||
|
|||
Still looking for assistance
|
#11
|
||||
|
||||
The macro I provided works fine on my machine. You haven't provided any guidance on where it is failing on your machine so it is hard to know why it isn't working there.
Try stepping through the macro one line at a time by clicking in the sub and then pressing F8 repeatedly. If you only have Word docs in the folder, you could disable the If and End If lines for instance.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#12
|
|||
|
|||
|
#13
|
||||
|
||||
Unfortunately, I am on a network that blocks Google drive so I won't be able to look at this until I am home from a business trip.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#14
|
|||
|
|||
Guessed, any luck looking at that google doc ?
|
#15
|
||||
|
||||
Your screenshot shows you didn't follow the instructions. You had problems with the function so to eliminate that I said the line should be
sPath = "C:\My Files" you made it sPath = SelectFolder("C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized") Based on that path, I would have expected you to make it sPath = "C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized" Despite that error, it appears the macro runs to completion and fails to find any files that meet the requirements. I am not sure how OneDrive works so it could be that there aren't any Word documents in that folder or perhaps OneDrive changes them in some way. Try this modification with the Immediate Window showing so you can trace why the code is not finding any Word documents in the supplied folder Code:
Sub BatchPageSizer() Dim sPath As String, aSect As Section, aDoc As Document, iCounter As Integer Dim oFSO As Object, oFolder As Object, oFile As Object sPath = "C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized" Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(sPath) Debug.Print "Files in Folder: " & oFolder.files.count For Each oFile In oFolder.files Debug.Print oFile.Name, oFile.Type If Left(oFile.Type, 14) = "Microsoft Word" And Left(oFile.Name, 1) <> "~" Then Set aDoc = Documents.Open(FileName:=oFile.Path, Visible:=True, AddToRecentFiles:=False) iCounter = iCounter + 1 For Each aSect In aDoc.Sections aSect.PageSetup.PageWidth = InchesToPoints(15) aSect.PageSetup.PageHeight = InchesToPoints(8.5) Next aSect aDoc.Close SaveChanges:=True End If Next MsgBox "Docs processed: " & iCounter, vbOKOnly, "Macro Finished" End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
can't draw a line in table that is continuing on multiple paper sheets | katka | Word Tables | 1 | 01-24-2015 12:09 AM |
Resize multiple PowerPoint objects in a table at the same time | Duradel | Word Tables | 3 | 11-16-2014 04:01 PM |
Resize multiple pictures in a Word 2010 table | JBA479 | Word VBA | 1 | 01-24-2014 08:51 PM |
convert multiple csv files to multiple excel files | mit | Excel | 1 | 06-14-2011 10:15 AM |
Resize video across multiple slides | joelas | PowerPoint | 3 | 09-28-2010 07:59 PM |