Word VBA: Save as Picture [closed] - vba

Question

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 1 year ago.
Improve this question
Does anyone know if it's possible to run the Word "Save as Picture" dialog from VBA?
Note:
I've searched high and low to no avail, suggesting it just may not be possible.
Still, thought it worth at least asking.
To clarify (as requested): This question is simply as asked.
At the time of asking, I could not find an answer to that anywhere. At the time of this editing, this is the only place I know of that answers this question (i.e. the basic question of can this be done, and if so how?).
As it turns out, yes it can be done (see below for how). And, while there may be other ways to do something similar by evoking architecturally different approaches (which I had already seen at the time of asking), they don't answer the question as asked.
Now, I can't see what's unclear about that or why it needs or more details.
So now I ask: Is there something fundamentally wrong with asking a question like this here on SO?

Answer 1

Turns out the solution was there, just hard to find. While the control isn’t on the ribbon, it still exists in the CommandBars. I managed to expose that by dumping out a list of all CommandBar controls (to find it and get the id). So, the solution is:
''' Note: Picture must be selected first
CommandBars.FindControl(ID:=5736).Execute

Answer 2

You can use PowerPoint to export the graphic. Here's a macro from a recent project that exports a map of the world. The Word graphics are EMF files:
Public Sub ExportMap()
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShapeRange As PowerPoint.ShapeRange
Dim Path$, File$
Dim oRange As Range
Application.ScreenUpdating = False
myDate$ = Format(Date, "m-d-yyyy")
Set pptApp = CreateObject("PowerPoint.Application")
Path$ = ActiveDocument.Path & Application.PathSeparator
File$ = "WorldMap " & myDate$ & ".png"
Set pptPres = pptApp.Presentations.Add(msoFalse)
Set oRange = ActiveDocument.Bookmarks("WholeMap").Range
oRange.CopyAsPicture
Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
On Error Resume Next
With pptPres.PageSetup
.SlideSize = 7
.SlideWidth = 1150
.SlideHeight = 590
End With
Set pptShapeRange = pptSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile, Link:=msoFalse)
pptSlide.Export Path$ & File$, "PNG"
pptApp.Quit
Set pptPres = Nothing
Set pptApp = Nothing
Set pptSlide = Nothing
Application.ScreenUpdating = True
MsgBox "All done! Check the folder containing this template for a file called '" & File$ & "'."
End Sub