Fill an autoshape with prompted picture

[aehan]

Hi
I'm trying to work out code that will prompt the user to fill a selected
autoshape with a picture. I have played around and looked for help on this,
so far all I can come up with is:

Sub InsertPictureBackground()

' Insert picture background in an autoshape allowing user to select the
picture

With Dialogs(wdDialogInsertPicture)
If .Show Then
With Selection.ShapeRange
.Height = imageHeight
.Width = imageWidth
End With
End If
End With

End Sub

This inserts a picture behind the autoshape, not in it. Can anyone help me
please?

Thank you
Aehan

 

[That Guy]

Hi
I'm trying to work out code that will prompt the user to fill a selected
autoshape with a picture.  I have played around and looked for help on this,
so far all I can come up with is:

Sub InsertPictureBackground()

' Insert picture background in an autoshape allowing user to select the
picture

    With Dialogs(wdDialogInsertPicture)
        If .Show Then
            With Selection.ShapeRange
                .Height = imageHeight
                .Width = imageWidth
            End With
        End If
    End With

End Sub

This inserts a picture behind the autoshape, not in it.  Can anyone help me
please?

Thank you
Aehan

Ok put this in a command button:

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String

OpenFile.lStructSize = Len(OpenFile)
sFilter = "Image Files(*.BMP;*.JPG;*.GIF)" & Chr(0) &
"*.BMP;*.JPG;*.GIF" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = Left(ActiveDocument.FullName, InStrRev
(ActiveDocument.FullName, "\"))
OpenFile.lpstrTitle = "Please Select The Picture To Add"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn <> 0 Then
ActiveDocument.Shapes("Rectangle 2").Fill.UserPicture
OpenFile.lpstrFile
End If

and this in a module:

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

then when the user pushes the button they will be prompted to find the
picture they want and then it will be placed in the object "Rectangle
2". You will need to replace this with the name of your shape.

good luck

 

[Jay Freedman]

Hi
I'm trying to work out code that will prompt the user to fill a
selected autoshape with a picture. I have played around and looked
for help on this, so far all I can come up with is:

Sub InsertPictureBackground()

' Insert picture background in an autoshape allowing user to select
the picture

With Dialogs(wdDialogInsertPicture)
If .Show Then
With Selection.ShapeRange
.Height = imageHeight
.Width = imageWidth
End With
End If
End With

End Sub

This inserts a picture behind the autoshape, not in it. Can anyone
help me please?

Thank you
Aehan

The problem with your code is that calling the .Show method of the dialog
makes the dialog carry out its ordinary operations, which put the picture
into the base layer of the document, not into the fill of the shape. What
you need to do is call the .Display method instead, which just displays the
dialog and collects the user's information, but doesn't do anything with it.
Then your code can use the selected file name to fill the shape:

Sub FillShapeWithPicture()
Dim fn As String
Dim dlg As Dialog
Dim oShp As Shape

' make sure there is a shape in the selection
If Selection.ShapeRange.Count = 0 Then
MsgBox "Please select the shape to fill " & _
"and rerun the macro."
Exit Sub
End If

' if you get here, there is a shape, so assign it
' to an object variable
Set oShp = Selection.ShapeRange(1)

' use the dialog only to get the user's choice
' and retrieve its file name
Set dlg = Dialogs(wdDialogInsertPicture)
With dlg
If .Display = -1 Then ' OK button
fn = .Name
Else
GoTo bye
End If
End With

' fill the shape object with the selected picture
oShp.Fill.UserPicture fn

bye:
' clean up
Set dlg = Nothing
Set oShp = Nothing
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[aehan]

Thanks Jay, I'll use that code and really appreciate your help. Also thanks
to That Guy, I'll go through that code too until I understand it, although
I'm using 2007, so it's easier for me to use Jay's code. I think all of you
people on Discussion Groups are fantastic!

Aehan