#1
|
|||
|
|||
Loop through pages from cursor position to end of pages
I'm trying to create a vba to loop through current page to the end of page and paste a copied shape on each of said pages. I tried: Code:
Sub PasteAndAlignItems() Dim totalPages As Integer Dim currentPage As Integer Dim startPosition As Range totalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Set startPosition = Selection.Range For currentPage = 1 To totalPages startPosition.Select Selection.PasteSpecial Placement:=wdInLine Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1 Next currentPage End Sub Anyone knows what's wrong? It would be very helpful if someone could add a snippet to position the pasted shape with horizontal alignment (left relative to page), vertical alignment (top relative to page). Last edited by nubuki; 12-10-2023 at 10:47 AM. Reason: Grammatical fixes |
#2
|
||||
|
||||
I can't see how it works for text because on each iteration you are returning to the original startPosition just before pasting at the selection location. It would make more sense to just remove the two lines that use startPosition.
When it comes to a shape in the clipboard that you are pasting, this can be complicated because Word appears to forget its positioning settings unless you include the paragraph it was anchored to in your clipboard. It is also tricky to just reposition the shape with code since there isn't an obvious way to work out which shape you just pasted. Maybe check the range of the current paragraph to see if it has any shapes anchored - but what happens if there is two or more? Can you explain the reason you want code to do this? Perhaps there is a better way than using the clipboard and selection objects. If you create the shape with vba it is easy to get a handle for it so that you can position it consistently.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Quote:
I moved the set start position into the loop It works but skips the second page and paste on the rest of the pages Edit: I removed it completely like you said. And it worked. Copying with the paragraph works as you said I'm trying to paste a bunch of shapes then fill them with consecutive pictures in a folder I'm currently inserting the pictures manually. Is there any method to achieve this through vba? Regards, Nubuki. Last edited by nubuki; 12-11-2023 at 07:00 AM. |
#4
|
||||
|
||||
I think VBA will be relatively straightforward if the shape is always the same. I would be inclined use inline shapes though as it takes a lot of the complexity away.
If you post a sample document showing a couple of the graphics as you expect to see them then I can probably offer some code that would reproduce that from a folder of images.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Quote:
I'm using a shape instead of inserting directly because each photo size is dynamic. I managed to write a vba that fill all shapes in a document with specified pictures: Code:
Sub FillShapesWithPictures() Dim dialog As FileDialog Dim selectedFiles As FileDialogSelectedItems Dim i As Integer Set dialog = Application.FileDialog(msoFileDialogFilePicker) dialog.Title = "Select multiple JPG files" dialog.Filters.Add "JPEG files", "*.jpg; *.jpeg", 1 If dialog.Show = -1 Then Set selectedFiles = dialog.SelectedItems i = 1 For Each shape In ActiveDocument.Shapes If i <= selectedFiles.Count Then shape.Fill.UserPicture selectedFiles(i) i = i + 1 Else Exit For End If Next shape End If End Sub Any way to combine them? Regards, Nubuki. |
#6
|
||||
|
||||
When you say you want to fill the shape, are you intentionally cropping the images to fit the shape of the box?
I would suggest you try the following which doesn't crop the images but allows you to specify a maximum size for the shape width or height. Code:
Sub ImportFolderOfImages() Dim objFSO As Object, objFolder As Object, objFile As Object, sPath As String Dim aDoc As Document, aPict As InlineShape, iMaxSize As Integer, dblRatio As Double Set aDoc = ActiveDocument iMaxSize = CentimetersToPoints(6) 'Set your maximum width sPath = SelectFolder 'Prompt user to select a path If Len(sPath) = 0 Then Exit Sub 'Exit if folder not selected Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create late bound instance FileSystemObject Set objFolder = objFSO.GetFolder(sPath) 'Get the folder object 'loop through each file in the directory and import any graphics For Each objFile In objFolder.Files Debug.Print objFile.Name, objFile.Type On Error GoTo SkipFails 'will fail if not importable graphic format Set aPict = aDoc.Paragraphs.Last.Range.InlineShapes.AddPicture(FileName:=objFile.Path) If Not aPict Is Nothing Then aPict.LockAspectRatio = msoTrue If aPict.Width > aPict.Height Then aPict.Width = iMaxSize Else aPict.Height = iMaxSize End If aPict.AlternativeText = objFile.Name aDoc.Range.InsertAfter vbCr End If SkipFails: Next objFile End Sub Function SelectFolder(Optional sTitle As String = "Choose a Folder:", Optional sInitialPath As String) As String With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Title = sTitle .InitialFileName = sInitialPath .Show SelectFolder = .SelectedItems(1) End With End Function
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Tags |
macro, ms-word, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to extract specific pages (Category) or arrange pages in a mail merge document? | kitlwy | Mail Merge | 7 | 09-30-2021 04:50 AM |
Number Pages - not total pages, but actual pages. | Kiminator321 | Word | 8 | 04-29-2020 03:07 PM |
Scroll through pages on loop | ndearing | Word VBA | 5 | 12-17-2015 08:46 AM |
Placing the same object/picture on all pages but on alternative (mirror position) - | alceste | Drawing and Graphics | 1 | 09-29-2013 06:28 PM |
create letter template with fixed position fields and follow up pages | Lynn O'Shea | Word | 3 | 05-18-2010 12:32 AM |