Copy Range, Paste as pic to Word, repeat and paste to the same Word doc.

[Scheballs]

Hello All,

First post here so please be kind.


Do you know the best way in Excel VBA to Copy a range, Open Word, Paste it as a Picture and then, change the dashboard to show a different chart(because my file is a dashboard similar to Chandoo's "Interactive Chart" using pick lists), copy that range again and paste it as a picture to the same word doc?


In my dashboard, which is downloaded from our company's Intranet, the User will Activate 4 cells which become, [valFacilityPicked] , [valDomainPicked] , [valLocationPicked] , and [valQuestionPicked]. Once all four are picked the dashboard shows a different chart.


Now, I envision a way to automagically copy each of the 10 possible charts for the users picked Location and the 10 Questions that there are for that Location will be pasted as pictures on their own landscaped pages in Word.

Having excel know what word doc to add the paste to each time is my problem. Depending who opens this it could be in many different network directories so referencing the same directory is where I am stumped.


I have been searching Google for a while with little results. I would hate to record a macro and run through all those steps, but I don’t think it records what I do in Word. Do I have to record a macro in word to get the code I would need to format the word page? This still wont solve my problem with getting the same word doc to paste into. Do I need to create a predefined word doc and use that each time?


I would post my file but I dont think I can share the information it has.


Thanks in Advance,

 

[SirJB7]

Hi, Brent S!


First of all welcome to Chandoo's website Excel forums. Thank you for your joining us and glad to have you here.


As a starting point I'd recommend you to read the green sticky topics at this forums main page. There you'll find general guidelines about how this site and community operates (introducing yourself, posting files, netiquette rules, and so on).


Among them you're prompted to perform searches within this site before posting, because maybe your question had been answered yet.


Feel free to play with different keywords so as to be led thru a wide variety of articles and posts, and if you don't find anything that solves your problem or guides you towards a solution, you'll always be welcome back here. Tell us what you've done, consider uploading a sample file as recommended, and somebody surely will read your post and help you.


And about your question...


Consider uploading a sample file (including manual examples of desired output), it'd be very useful for those who read this and might be able to help you. Thank you.

Give a look at the green sticky posts at this forums main page for uploading guidelines.


Regarding the contained information check this GSP:

http://chandoo.org/forums/topic/phd-forum-posting-rules-etiquette-pls-read-before-posting

In 4th to 6th paragraphs you may find:

"- Don't leave out information more info is better

- Be wary that you are posting information on a public web site and that if you post confidential data, it won’t be confidential for long.

- Randomize Numbers and Names if appropriate."


I know it's an overload but it's your better way to help others help you.


Regards!

 

[Scheballs]

Thanks SirJ, I'll give it a read.

I may have found a solution after meeting with a friend of mine for an hour.

The For Loops are just there to pick the correct cells in the Dashboard to display the next possible Chart.


---------------------------

[pre]

Sub ExportToWord()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add

'User Prompt to Continue or Not
MSG1 = MsgBox("This can take 30 to 60 seconds to export, Excel and Word will be hidden until I am done. Would You Like to Continue with the Export?", vbYesNo, "Export All Charts for All Questions for " & Worksheets("Calculations").Range("F7"))
If MSG1 = vbNo Then
Exit Sub
End If

'Hide Excel and Word
wrdApp.Visible = False
Application.Visible = False

wrdApp.Selection.PageSetup.Orientation = wdOrientLandscape
With wrdApp.Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.25)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.25)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.2)
.FooterDistance = InchesToPoints(0.2)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

Dim EndIterater As Integer
Dim Picture As Integer
Picture = 1
For i = 1 To 10

Range("C" & 20 + i).Select

If Range("H46").Value = "" Then

EndIterater = 1

ElseIf Range("H50").Value = "" Then

EndIterater = 3

Else

EndIterater = 4

End If

For j = 1 To EndIterater

If j = 1 Then

Range("H40").Select

ElseIf j = 2 Then

Range("H42").Select

ElseIf j = 3 Then

Range("H46").Select

ElseIf j = 4 Then

Range("H50").Select

End If

' Copy from Excel to Word
Range("a1:ad69").Select
Selection.Copy
wrdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
'wrdApp.ActiveDocument.InlineShapes(Picture).ScaleWidth = 45
'wrdApp.ActiveDocument.InlineShapes(Picture).ScaleHeight = 45
Application.CutCopyMode = False ' set off copy mode of Excel
Picture = Picture + 1
Next

Next

'Make Excel and Word visible then scroll to top of word doc.
Application.Visible = True
Application.CutCopyMode = False
wrdApp.Visible = True
wrdApp.ActiveWindow.ActivePane.VerticalPercentScrolled = 0
wrdApp.ActiveWindow.ActivePane.HorizontalPercentScrolled = 0

' Release the memory
Set wrdDoc = Nothing
Set wrdApp = Nothing

End Sub

[/pre]
-------------------------

Thanks Again for the warm welcome.

 

[SirJB7]

Hi, Brent S!

Glad you solved it. Thanks for your feedback, for your kind words too and specially for sharing the solution with the community. And welcome back whenever needed or wanted.

Regards!