Microsoft Office Forums Resize Paper for Multiple Files

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-26-2019, 07:43 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default 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 ?
Reply With Quote
  #2  
Old 07-27-2019, 01:39 AM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
  #3  
Old 07-27-2019, 05:19 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

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
Reply With Quote
  #4  
Old 07-27-2019, 05:20 PM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
  #5  
Old 07-27-2019, 05:57 PM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Gave me an error with:

Function SelectFolder(Optional sTitle As String = "Select a Folder") As String
Reply With Quote
  #6  
Old 07-27-2019, 06:04 PM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
  #7  
Old 07-28-2019, 05:52 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Now says 0 files processed, seems the macro is working but it didn't do anything
Reply With Quote
  #8  
Old 07-28-2019, 06:20 AM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

Do you have Word documents in the path you pointed it at?
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #9  
Old 07-28-2019, 06:37 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Yes, I have several word documents in the folder
Reply With Quote
  #10  
Old 08-01-2019, 04:17 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Still looking for assistance
Reply With Quote
  #11  
Old 08-01-2019, 05:34 AM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
  #12  
Old 08-01-2019, 11:51 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Attached a Google Drive Image

Screenshot (7).png - Google Drive
Reply With Quote
  #13  
Old 08-01-2019, 03:26 PM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
  #14  
Old 08-20-2019, 07:50 AM
cefd1 cefd1 is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2019
Novice
Resize Paper for Multiple Files
 
Join Date: Jul 2019
Posts: 8
cefd1 is on a distinguished road
Default

Guessed, any luck looking at that google doc ?
Reply With Quote
  #15  
Old 08-20-2019, 03:25 PM
Guessed's Avatar
Guessed Guessed is offline Resize Paper for Multiple Files Windows 10 Resize Paper for Multiple Files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,261
Guessed has a spectacular aura aboutGuessed has a spectacular aura aboutGuessed has a spectacular aura about
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


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 Paper for Multiple Files 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
Resize Paper for Multiple Files convert multiple csv files to multiple excel files mit Excel 1 06-14-2011 10:15 AM
Resize Paper for Multiple Files Resize video across multiple slides joelas PowerPoint 3 09-28-2010 07:59 PM


All times are GMT -7. The time now is 08:22 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft