StefaniaZ
10-09-2019, 04:48 AM
Goodmorning :)
I'm writing a macro to copy images from an Excel sheet to a specific Word file (in my case, "Pippo2").
This macro look if the word file is open and, if not, the macro do it.
My problem is that when I paste more than one image, the new one overwrites the previous, but I would like to have all the images one under the other. Someone could help me?
Here my code:
Dim xPic As Picture
Dim WordApp As Object
Sub sposta()
For Each xPic In ActiveSheet.Pictures
xPic.Select
Selection.Copy
On Error Resume Next
Set WordApp = GetObject(, "Word.application") 'gives error 429 if Word is not open
If Err = 429 Then
Set WordApp = CreateObject("Word.application") 'creates a Word application
Err.Clear
End If
fileword = "C:\Users\szuttion\Desktop\Pippo2.docx"
WordApp.Visible = True
If fileword = "False" Then Exit Sub
With WordApp.Documents.Open(fileword)
.Content.InsertAfter vbCr
.Range.Paste
End With
Set WordApp = Nothing
Next
End Sub
PS: sorry for my english, it's not my motherlanguage :)
I'm writing a macro to copy images from an Excel sheet to a specific Word file (in my case, "Pippo2").
This macro look if the word file is open and, if not, the macro do it.
My problem is that when I paste more than one image, the new one overwrites the previous, but I would like to have all the images one under the other. Someone could help me?
Here my code:
Dim xPic As Picture
Dim WordApp As Object
Sub sposta()
For Each xPic In ActiveSheet.Pictures
xPic.Select
Selection.Copy
On Error Resume Next
Set WordApp = GetObject(, "Word.application") 'gives error 429 if Word is not open
If Err = 429 Then
Set WordApp = CreateObject("Word.application") 'creates a Word application
Err.Clear
End If
fileword = "C:\Users\szuttion\Desktop\Pippo2.docx"
WordApp.Visible = True
If fileword = "False" Then Exit Sub
With WordApp.Documents.Open(fileword)
.Content.InsertAfter vbCr
.Range.Paste
End With
Set WordApp = Nothing
Next
End Sub
PS: sorry for my english, it's not my motherlanguage :)