Solved: Fill imagebox in userform with a specified picture

[vicenflor]

Hello,

I have the following problem. I have inserted a total of 6 pictures into
specified cells of a table in word. To achieve this, I use the code below and
this is running OK :

'row = 6
'column = 2

Set rgDest = Selection.Tables(1).Cell(row, column).Range

Set shpShape = ActiveDocument.Shapes.AddPicture _
(FileName:=StrFile, LinkToFile:=True, _
SaveWithDocument:=False, Anchor:=rgDest)

With shpShape
.Name = "photo1"
.LockAnchor = True
.LockAspectRatio = msoTrue

.Height = CentimetersToPoints(6.65)
.Left = CentimetersToPoints(-0.2)

End With

The problem now is : I want to select each of these pictures and place it in
one of the 6 imageboxes of a userform. This is possible by the code :

set userform1.photo1.picture = loadpicture(strfile), but for some reasons I
want to fill the imageboxes based on the name (for instance "photo1" in my
example) or another identifier of the shape in my document. I only need to be
sure to pick the photo in my document and place it in the correct imagebox of
my userform.

Can anybody help me with this?

Thanks,
Vicenflor

[Killian]

Hi and welcome to VBAX :hi:

I think the easiest way to solve this would be to save the path of the picture in the "AlternativeText" property of the shape object, which you can then use with the loadpicture function.
I've tested this idea with the following code, where the shapes are named "photo1", "photo2", etc and the image boxes are similarly named "Image1", "Image2", etc'placing the pictures in the table
strfile = "N:\Killian\2002 Archive\filez\Pix\RedBull_K.bmp"
r_max = 2
c_max = 3

For r = 1 To r_max
For c = 1 To c_max

cellcount = ((r - 1) * c_max) + c

Set rgdest = Selection.Tables(1).Cell(r, c).Range

Set shpShape = ActiveDocument.Shapes.AddPicture _
(FileName:=strfile, LinkToFile:=True, _
SaveWithDocument:=False, Anchor:=rgdest)
With shpShape
.Name = "photo" & cellcount
.LockAnchor = True
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(6.65)
.Left = CentimetersToPoints(-0.2)
.AlternativeText = strfile
End With
Next c
Next r

'userform code to load the imageboxes
r_max = 2
c_max = 3

For r = 1 To r_max
For c = 1 To c_max

cellcount = ((r - 1) * c_max) + c

For Each img In UserForm1.Controls
If img.Name = "Image" & cellcount Then
img.Picture = LoadPicture(ActiveDocument.Shapes("Photo" & cellcount).AlternativeText)
End If
Next img
Next c
Next r
Hope that helps

[vicenflor]

Hello Killian,

Thanks for your attempt to help me. The code you supplied works perfectly. However, there is still one problem when the original file is no longer available on the hard disk.

In the "set shpshape" code, I take the option "savewithdocument:=True" in order to save all photos with the document. I thought this should give me the opportunity to delete the original photos or to use the application on another pc not having these originals. But this seems to be wrong. In these case I cannot load a picture in my image boxes on my userform.

Untill now, I only see 1 solution now : saving the photos as a jpg file somewhere on the hard disk and then call this file with the loadpicture command. But I think that it is even not possible to save photos as a jpg file within word?

So I don't see any solution for my problem.

Vicenflor

[fumei]

You can not use loadpicture except with a filename/path. Killian's variable strfile, and AlternativeText (which is strfile) are filename/path. Essentially, both are point to a disk file. Therefore the filename/path must be valid.

While SaveWithDocument does save the contents, its saves that content as a byte array with the document. It is not a valid filename/path, and can not be used - as far as I know - with loadpicture.

In other words, no, you can depend on the image being available. Do not delete the originals!

Since you need to retain the originals, forget about saving images - brought in I asssume as JPG - as JPG in Word. Why if you still have the originals.

JPG brought into Word go through a graphics filkter. Trying to save them out deteriorates them badly. Not totally, but no matter how much Microsoft may want to pretend otherwise Word is NOT a graphics application.

Killian's approach is workable, and rather elegant. You need the image originals. You could do it using a VBA compliant graphics application, say Corel Photo-paint. to get the image out of Word, but this is totally idiotic as the overhead to run Corel is not worth it.

Save the originals as disk files, and load with loadpicture.

[vicenflor]

OK,

Thanks Gerry.

Now at least I know I don't have to look any further.

Vicenflor

[Killian]

Hi again,

Well Gerry's filled you in on the bad news with Image controls... although there may be a way around it, depending on how important it is to preview document images on the userform.

I've done this before in PowerPoint, basing the method on Stephen Bullen's PastePicture code (found here (http://www.oaltd.co.uk/Excel/Default.htm)) - it worked nicely in PPT2003, but not in 2002 since the picture format PowerPoint uses appears to be different. Well I just tried the technique in Word (2003) but had the same issues. Which leads me to my point - because I could export the pictures in PPT and then use LoadPicture with the path of the exported file. So rather than thinking in terms fo a graphics app, if you can be confident that users of your document will have PowerPoint as part of their office setup you can use the following method...

Open PowerPoint in the background
For each picture:
Copy the pic in Word
Paste the pic into PPT
Export pic from PPT as a file to the user's temp directory
Use LoadPicture with the exported file and temp path
Delete temp pic file
When all pic are processed, close PPT

There are 3 issues with this:
A user may not have PowerPoint (you'd have to detect this and maybe display ("preview not available" labels on the imageboxes)
The preview image quality will be fairly poor (no big deal if they're small image boxes)
It's still a lot of overhead for a few previews

Like I said, it depends how important these image previews are. Let me know if you need some code

[vicenflor]

Hello Killian,

I'm certainly interested to try out your proposal because in my application everything is controlled by the userform and it's a pity that I can not show a picture to the operator showing what is on the document.

Every pc has powerpoint and also the image windows on my userform is quite small. The image windows serves only to give the operator an idea of the real picture which is on the document. There is a possibibility to double click on each window to enlarge the photo to half screen size, but it doesn't disturb me that the quality of the image is poor in that case.

I only hope that visualizing the images in the image window does not consume too much time, but I'm interested in testing this out.

Anyway, many thanks to ring up this solution.

Vicenflor

[Killian]

OK then, we have lift off... :thumb

I've expanded the userform code to use this method, it seems to work nicely :whistle:
You will need to add a reference to the MS PowerPoint Object Model (in VBE>Tools>References) - or you can change it to use late-binding if you need to.
The example uses the same "InsertPicture" code as before, that names the pictures an inserts them into a 2 row, 3 col tableDim strPath As String
Dim r_max As Long, c_max As Long
Dim r As Long, c As Long, cellcount As Long
Dim img As Control
Dim shpShape As Object
Dim appPPT As PowerPoint.Application
Dim presPPT As PowerPoint.Presentation
Dim sldPPT As PowerPoint.Slide
Dim blnNewPPT As Boolean

'get the temp directory for the user's profile
strPath = Environ("TEMP") & "\"

r_max = 2
c_max = 3

'Get existing instance of PowerPoint; otherwise create a new one
On Error Resume Next
Set appPPT = GetObject(, "PowerPoint.Application")
If Err.Number = 0 Then
blnNewPPT = False
Else
Set appPPT = New PowerPoint.Application
blnNewPPT = True
End If
On Error GoTo 0
'Add a new presentation
Set presPPT = appPPT.Presentations.Add
'add a blank slide
Set sldPPT = presPPT.Slides.Add(1, ppLayoutBlank)
'appPPT.Visible = msoTrue

'this is basically the same loop for the imageboxes
For r = 1 To r_max
For c = 1 To c_max
cellcount = ((r - 1) * c_max) + c
For Each img In UserForm1.Controls
If img.Name = "Image" & cellcount Then
'select the pic by it's name and copy it
ActiveDocument.Shapes("Photo" & cellcount).Select
Selection.CopyAsPicture
'paste into powerpoint, name the pic and export it to the temp directory
Set shpShape = sldPPT.Shapes.Paste
shpShape.Name = "Photo" & cellcount
sldPPT.Shapes("Photo" & cellcount).Export strPath & "Photo" & cellcount & ".bmp", ppShapeFormatBMP
'load the pic from the temp file, then delete the pic and file
img.Picture = LoadPicture(strPath & "Photo" & cellcount & ".bmp")
shpShape.Delete
Kill strPath & "Photo" & cellcount & ".bmp"
End If
Next img
Next c
Next r

'close our temp presentation
presPPT.Saved = msoTrue
presPPT.Close
'if we created a new PPT app, then quit it
If blnNewPPT Then
appPPT.Quit
End If

[vicenflor]

Hello Killian,

Just one additional remark. I think there could be another solution : using the microsoft photo editor (available under microsoft office tools) instead of powerpoint. I tried manually to paste a picture from my word document to this photo editor and then save it as a jpg file and this seems to work. I had the impression that the quality of this picture was not so bad and the file size of the photo was the same as the original photo.

I will try some things out this evening, but it would be great if you could supply me at least the code for powerpoint because I'm not yet an experienced VBA user.

Thanks
Vicenflor

[vicenflor]

I have one additional question about the reference to the MS PowerPoint Object Model which I have to select in VBE>Tools>References, as indicated by the reply of Killian.

What will happen if my application will be run on a pc where the reference to MS PowerPoint Object Model is not selected? Will it function normally or will I get an error? In case it will give an error, is it possible to select the reference to the MS PowerPoint Object Model automatically with vba at the start of my word application? What will be the code?

Vicenflor

[Killian]

Hi Vicenflor

The reference is set and saved with your VBA project. This simply means that you are using objects that are included in PowerPoint, so it will run on a PC that has PowerPoint installed.
You may have problems if another user has an earlier version of PowerPoint than the one you reference.
If you want your code to be more robust then you can use "Late-binding", which means instead of using Tools>References to add the object model, you create the object (in this case, the PowerPoint application, presentation and slide) at run-time with CreateObject. Here's the code I posted, using late-binding. There are only a few changes - I've commented them so you can see the differenceDim strPath As String
Dim r_max As Long, c_max As Long
Dim r As Long, c As Long, cellcount As Long
Dim img As Control
Dim shpShape As Object
'change the variables to Objects
'because at the moment, there's no reference to PPT
Dim appPPT As Object
Dim presPPT As Object
Dim sldPPT As Object
Dim blnNewPPT As Boolean

strPath = Environ("TEMP") & "\"

r_max = 2
c_max = 3

On Error Resume Next
Set appPPT = GetObject(, "PowerPoint.Application")
If Err.Number = 0 Then
blnNewPPT = False
Else
'now we create an oject of class type "PowerPoint.Application"
Set appPPT = CreateObject("PowerPoint.Application")
blnNewPPT = True
End If
On Error GoTo 0
appPPT.Visible = msoTrue

Set presPPT = appPPT.Presentations.Add
'we use the constant value 12 for "ppLayoutBlank"
'because without the object model, VBA doesn't know the constant values
Set sldPPT = presPPT.Slides.Add(1, 12)

For r = 1 To r_max
For c = 1 To c_max
cellcount = ((r - 1) * c_max) + c
For Each img In UserForm1.Controls
If img.Name = "Image" & cellcount Then

ActiveDocument.Shapes("Photo" & cellcount).Select
Selection.CopyAsPicture
Set shpShape = sldPPT.Shapes.Paste
shpShape.Name = "Photo" & cellcount
sldPPT.Shapes("Photo" & cellcount).Export strPath & "Photo" & cellcount & ".bmp", ppShapeFormatBMP
img.Picture = LoadPicture(strPath & "Photo" & cellcount & ".bmp")
shpShape.Delete
Kill strPath & "Photo" & cellcount & ".bmp"
End If
Next img
Next c
Next r
presPPT.Saved = msoTrue
presPPT.Close
If blnNewPPT Then
appPPT.Quit
End If

[vicenflor]

Hi Killian,

It's me once again. I have "translated" your code into my application and it works fine, but only for the first picture. For the second picture, I get the error "Run time error 462 - The remote server machine does not exist or is unavailable". This error is displayed when I come to the line "shpPPT.Name = "Img" & cellcount" in the Sub Openpowerpoint . Could somebody help me to fix this problem? My complete code is displayed below.

Thanks
Vicenflor
OpenPowerpoint
Set UserForm1.Foto1Open.Picture = LoadPicture(strPath & "Img" & cellcount & ".jpg")
UserForm1.Repaint
SluitPowerpoint
.........


Public Sub OpenPowerpoint()
On Error Resume Next
strPath = Environ("TEMP") & "\"
Set appPPT = GetObject(, "PowerPoint.Application")
If Err.Number = 0 Then
blnNewPPT = False
Else
Set appPPT = CreateObject("PowerPoint.Application")
blnNewPPT = True
End If
On Error GoTo 0
'Add a new presentation
Set presPPT = appPPT.Presentations.Add
'add a blank slide
Set sldPPT = presPPT.Slides.Add(1, 12)
appPPT.Visible = msoTrue

Documents(Fotodocument).Activate
ActiveDocument.Shapes("img" & cellcount).Select
Selection.CopyAsPicture


Set shpPPT = sldPPT.Shapes.Paste
shpPPT.Name = "Img" & cellcount
sldPPT.Shapes("Img" & cellcount).Export strPath & "Img" & cellcount & ".jpg", ppshapeFormatjpg
End Sub


Public Sub SluitPowerpoint()

'load the pic from the temp file, then delete the pic and file

shpPPT.Delete
Kill strPath & "Img" & cellcount & ".jpg"

'close our temp presentation
presPPT.Saved = msoTrue
presPPT.Close
'if we created a new PPT app, then quit it
If blnNewPPT Then
appPPT.Quit
End If
End Sub

[fumei]

Ack. Please use the code window, and please use underscores (_) to break it up.

Thanks!

[Killian]

Where is the cellcount variable set?
This could be a problem because each shape must have a unique name.
Also, you say it's your complete code, but I don't see your variables dimensioned anywhere (e.g Dim shpPPT As Shape)
Because you have separated the code into different routines, they will need to be public (or module scope if all the code's in the same module/form)
Maybe you could post the Word file you're testing this with?

[vicenflor]

Hi Killian,

Finally I succeeded to get this part of my application to work :-)

I tried now to avoid switching frequently between word and powerpoint. In a first loop, I create all the jpg (or bmp) pictures of my word document to my temp directory using powerpoint. It's only in a second phase that I load the picture in my userform. Now, my code looks much more to what you proposed.

Anyway, thanks for all the assistance!

Vicenflor

[Killian]

Good to hear its all working :thumb
I've mark the thread as solved...