I developed a MS Word Macro for this situation:
Summary:
An excel file has 3 columns namely Image Path which holds the local file path of the image, Product Name which contains product name values and Product Link which contains the online store link values of each product.
The contents in the excel file are placed in the word document.
- The image using the image path is placed to the left of the document at the beginning.
- Then, the product name and product link are placed to the right of the image. -The image has text wrapping enabled with square wrapping style to wrap the texts to its right.
- Both the product name and product link text use Calibri font and size 14
- Some spacing formatting
The following is my code:
Sub CreateNewWordDocument()
' Declare variables
Dim wordApp As Object
Dim wordDoc As Object
Dim excelApp As Object
Dim excelWorkbook As Object
Dim excelWorksheet As Object
Dim lastRow As Long
Dim i As Long
Dim cumulativeTop As Single
Dim imageHeight As Single
cumulativeTop = 0 'Initializing cumulativeTop
' Create Word application object
On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
On Error GoTo 0
If wordApp Is Nothing Then
' If Word is not running, create a new instance
Set wordApp = CreateObject("Word.Application")
End If
' Make Word visible (optional)
wordApp.Visible = True
' Create a new Word document
Set wordDoc = wordApp.Documents.Add
' Create Excel application object
On Error Resume Next
Set excelApp = GetObject(, "Excel.Application")
On Error GoTo 0
If excelApp Is Nothing Then
' If Excel is not running, create a new instance
Set excelApp = CreateObject("Excel.Application")
End If
' Open the Excel file
Set excelWorkbook = excelApp.Workbooks.Open("C:\Users\virtu\Desktop\Product Details 3.xlsx")
Set excelWorksheet = excelWorkbook.Sheets(1) ' Assuming data is in the first sheet
' Find the last row with data in the Excel sheet
lastRow = excelWorksheet.Cells(excelWorksheet.Rows.Count, "A").End(-4162).row ' -4162 represents xlUp
' Loop through the rows in Excel and add content to Word document
For i = 2 To lastRow ' Assuming headers are in the first row
Set image = wordDoc.Shapes.AddPicture(FileName:=excelWorksheet.Cells(i, 1).Value, LinkToFile:=False, SaveWithDocument:=True, _
Width:=-1, Height:=-1)
With image:
' Set text wrapping for the image
.WrapFormat.Type = 0 ' Square wrapping style
' Set image position
.LockAspectRatio = msoTrue
.Left = 0
.Top = cumulativeTop
.Width = 150 ' Adjust the width as needed
.Height = 150 ' Adjust the height as needed
imageHeight = .Height
End With
'If cumulativeTop + imageHeight > 980 Then
'METHOD 1
' Add a new section for each image
'Dim newSection As Object
'Set newSection = wordDoc.Sections.Add
'newSection.PageSetup.SectionStart = 1 ' Start on a new page
'METHOD 2
'wordDoc.Paragraphs.Add.Range.InsertAfter vbNewLine & Chr(12)
'METHOD 3
' Insert a paragraph after the image
'wordDoc.Paragraphs.Last.Range.InsertParagraphAfter
'wordDoc.Paragraphs.Last.SpaceAfter = 12
'wordDoc.Paragraphs.Last.Range.InsertBreak Type:=7 ' 7 represents wdPageBreak
'End If
wordDoc.Paragraphs.Add.SpaceAfter = 28
productName = "Product Name: " & excelWorksheet.Cells(i, 2).Value
productLink = "Product Link: " & excelWorksheet.Cells(i, 3).Value
With wordDoc.Content
.InsertAfter productName & vbCrLf & productLink & vbCrLf
.Font.Size = 14
.Font.Name = "Calibri"
End With
' Add spacing between productName and productLink pair of text
wordDoc.Paragraphs.Add.SpaceAfter = imageHeight - 84
cumulativeTop = cumulativeTop + 150 + 28
Next i
' Clean up
Set wordDoc = Nothing
Set wordApp = Nothing
Set excelWorksheet = Nothing
Set excelWorkbook = Nothing
Set excelApp = Nothing
Set image = Nothing
End Sub
My output is as such: Figure shows my output
Perfect! I achieved my aims beautifully! But for one...
If you read my code above, you would realise an entire section was commented off.
'If cumulativeTop + imageHeight > 980 Then
'METHOD 1
' Add a new section for each image
'Dim newSection As Object
'Set newSection = wordDoc.Sections.Add
'newSection.PageSetup.SectionStart = 1 ' Start on a new page
'METHOD 2
'wordDoc.Paragraphs.Add.Range.InsertAfter vbNewLine & Chr(12)
'METHOD 3
' Insert a paragraph after the image
'wordDoc.Paragraphs.Last.Range.InsertParagraphAfter
'wordDoc.Paragraphs.Last.SpaceAfter = 12
'wordDoc.Paragraphs.Last.Range.InsertBreak Type:=7 ' 7 represents wdPageBreak
'cumulativeTop=0
'End If
When images were loaded into my document, it worked well. But when more was added and the entire page was occupied, the newer images didn't load onto a new page but remained at the bottom of the existing page. You couldn't make it out quite clearly in the output picture above since the images were on top of each other but you can see it in the picture below(I moved the pictures this time):
So, with the batch of code above (the code in if statement), whenever the sum of the cumulative .Top value of the images (where the newest image will be positioned) and the image's height is more than the page's height which is approximately 980 points, a page break will be applied and newer images will be loaded onto the next page to prevent overlapping.
I used 3 different methods as can be seen above but none worked on the images. BUT it worked for the text. As you can see, the images are still at the same location(or actually at the top since cumulativeTop variable is set to 0 to reset it).
Figure shows output after page break applied
Why doesn't the page break work? Can you all help me achieve this? Thank you very much in advance!
P.S. I cannot embedded images because I do not have 10 reputation points. Please do view the image through the Stack Imgur links.