oldmanwilly
Board Regular
- Joined
- Feb 24, 2016
- Messages
- 221
Can someone point me to or show me how to do this?
Thanks
Thanks
Sub recordme()
Dim appwd As Object
Dim shp As Shape
Dim sh As Worksheet
Set appwd = GetObject(, "Word.Application")
appwd.Visible = True
appwd.Documents.Add
For Each sh In Sheets
For Each shp In ThisWorkbook.Shapes
shp.Copy
appwd.Selection.Paste
Next shp
Next sh
End Sub
did a bit of tinkering and this code sort of works, it pastes all the shapes into the word document, it doesn't resize though and does just paste pictures but all shapes i.e drop down boxes etc.My code bellow works if you specify specific specific image names however I have 7 tabs some with 3 pictures on and i want them all to be copied over tot he word document
but the code has a type mismatch error on the thisworkbook.shapes line cans omeone help me please!
Code:Sub recordme() Dim appwd As Object Dim shp As Shape Dim sh As Worksheet Set appwd = GetObject(, "Word.Application") appwd.Visible = True appwd.Documents.Add For Each sh In Sheets For Each shp In ThisWorkbook.Shapes shp.Copy appwd.Selection.Paste Next shp Next sh End Sub
Sub recordme()
Dim appwd As Object
Dim shp As Shape
Dim sh As Worksheet
Set appwd = GetObject(, "Word.Application")
appwd.Visible = True
appwd.Documents.Add
For Each sh In Sheets
sh.Activate
For Each shp In ActiveSheet.Shapes
shp.Copy
appwd.Selection.Paste
Next shp
Next sh
End Sub
Sub Demo()
Dim wdApp As New Word.Application
Dim wdDoc As Word.document, xlWkSht As Excel.Worksheet
Dim xlShp As Excel.Shape, wdRng As Word.Range, wdShp As Word.Shape
Set wdDoc = wdApp.Documents.Add
With ThisWorkbook
For Each xlWkSht In .Worksheets
For Each xlShp In xlWkSht.Shapes
Select Case xlShp.Type
' Exclude these shapes:
Case msoFormControl, msoOLEControlObject, msoEmbeddedOLEObject, msoLinkedOLEObject
' Copy any others:
Case Else
xlShp.Copy
Set wdRng = wdDoc.Range
wdRng.Collapse wdCollapseEnd
wdRng.Paste
' Some Excel shapes are liable to end up pasted in-line in Word.
' The following ensures such objects are converted to floating shapes
If wdRng.InlineShapes.Count > 0 Then
Set wdShp = wdRng.InlineShapes(wdRng.InlineShapes.Count).ConvertToShape
Else
Set wdShp = wdRng.ShapeRange(wdRng.ShapeRange.Count)
End If
With wdShp
' You can reformat, resize and reposition the shape in Word here
End With
End Select
Next
Next
End With
wdApp.Visible = True
wdApp.Activate
Set wdApp = Nothing: Set wdDoc = Nothing: Set wdRng = Nothing: Set wdShp = Nothing
Set xlWkSht = Nothing: Set xlShp = Nothing
End Sub