Word UserForm - load images interactively with option buttons

[illogic]

Hello,

hopefully someone can answer my question.
I created a userform, separated into two frames.
The first frame has about 15 option buttons and the second frame has a image container.
What i would like to achieve is that when i activate one of the option buttons, a specified image from a fixed path is loaded into the container.
Every time i activate another option button the image changes to another image.

Is this somehow possible? If so, how would i go about realizing this?


greetings

Manuel

[gmaxey]

You will need the following code in standard module. Then for each optionbutton click event use something like:


Private Sub OptionButton1_Click()
If OptionButton1 Then
imgPreview.Picture = LoadPictureGDI("D:\Replacement Pic.jpg") 'Assumes your picture control is named imgPreview.
End If
End Sub





Option Explicit
'This module provides a LoadPictureGDI function, which can be used instead of VBA's LoadPicture, _
to load a wide variety of image types from disk - including png.

'The png format is used in Office 2007-2010 to provide images that include an alpha channel for each pixel's transparency

'Author: Stephen Bullen
'Date: 31 October, 2006
'Email: stephen@oaltd.co.uk

'Updated : 30 December, 2010
'By : Rob Bovey
'Reason : Also working now in the 64 bit version of Office 2010
'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

#If VBA7 Then
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type
'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
'Windows API calls into the GDI+ library
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As Long
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
'Windows API calls into the GDI+ library
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

' Procedure: LoadPictureGDI
' Purpose: Loads an image using GDI+
' Returns: The image as an IPicture Object
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim lResult As Long
#If VBA7 Then
Dim hGdiPlus As LongPtr
Dim hGdiImage As LongPtr
Dim hBitmap As LongPtr
#Else
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
#End If
'Initialize GDI+
uGdiInput.GdiplusVersion = 1
lResult = GdiplusStartup(hGdiPlus, uGdiInput)
If lResult = 0 Then
'Load the image
lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)
If lResult = 0 Then
'Create a bitmap handle from the GDI image
lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)
'Create the IPicture object from the bitmap handle
Set LoadPictureGDI = CreateIPicture(hBitmap)
'Tidy up
GdipDisposeImage hGdiImage
End If
'Shutdown GDI+
GdiplusShutdown hGdiPlus
End If
End Function
' Procedure: CreateIPicture
' Purpose: Converts a image handle into an IPicture object.
' Returns: The IPicture object
#If VBA7 Then
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
#Else
Private Function CreateIPicture(ByVal hPic As Long) As IPicture
#End If
Dim lResult As Long
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
'OLE Picture types
Const PICTYPE_BITMAP = 1
'Create the Interface GUID (for the IPicture interface)
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
'Fill uPicInfo with necessary parts.
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
'Create the Picture object.
lResult = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
'Return the new Picture object.
Set CreateIPicture = IPic
End Function

[illogic]

Hey,

thanks for the reply.
I tried to implement the code into my document but i only get a runtime error 424 when i tick on one of the option buttons.

i placed

Private Sub OptionButton1_Click()
If OptionButton1 Then
imgPreview.Picture = LoadPictureGDI("C:\artexImagePreview\DetRohrsicherung.jpg")
End If
End Sub
into the userform which contains the option buttons and placed the other code into a module.
Is that correct or do i need to place that code into 'This Document'?

I am currently very short on time so i wasn't able to investigate any further.

[gmayor]

The other code is fine in an ordinary module.

Provided the option buttons and picture control are correctly named and the file exists the macro works as written.

Did you actually use a picture control as your original message said something about 'frames'? If you are using frames, the named picture control must go in the frame.

The following userform code adds a bit more error handling. If the image doesn't exist, you will see a message box and the image control content will clear.


Option Explicit

Private Sub Userform_Initialize()
imgPreview.PictureSizeMode = fmPictureSizeModeZoom
End Sub

Private Sub OptionButton1_Click()
Dim fso As Object
Dim strPicture As String: strPicture = "C:\artexImagePreview\DetRohrsicherung.jpg"
If OptionButton1 Then
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(strPicture) Then
MsgBox "Image " & strPicture & " is not available"
End If
imgPreview.Picture = LoadPictureGDI(strPicture)
Set fso = Nothing
End If
End Sub

Private Sub OptionButton2_Click()
Dim fso As Object
Dim strPicture As String: strPicture = "C:\artexImagePreview\DetRohrsicherung2.jpg"
If OptionButton2 Then
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(strPicture) Then
MsgBox "Image " & strPicture & " is not available"
End If
imgPreview.Picture = LoadPictureGDI(strPicture)
Set fso = Nothing
End If
End Sub


Rather than use a raft of option buttons, I think I would have been inclined to use a two column combo box, with the first column containing the description and the second the file path e.g.


Private Sub ComboBox1_Change()
Dim fso As Object
Dim strPicture As String
With ComboBox1
Set fso = CreateObject("Scripting.FileSystemObject")
If .ListIndex > 0 Then
strPicture = .Column(1)
If Not fso.FileExists(strPicture) Then
MsgBox "Image " & strPicture & " is not available"
End If
imgPreview.Picture = LoadPictureGDI(.Column(1))
End If
End With
End Sub

Private Sub Userform_Initialize()
imgPreview.PictureSizeMode = fmPictureSizeModeZoom
With ComboBox1
.ColumnCount = 2
.ColumnWidths = .Width - 4 & ",0"
.AddItem
.List(0, 0) = "[Select Image]"
.AddItem
.List(1, 0) = "Picture 1"
.List(1, 1) = "C:\artexImagePreview\DetRohrsicherung.jpg"
.AddItem
.List(2, 0) = "Picture 2"
.List(2, 1) = "C:\artexImagePreview\DetRohrsicherung2.jpg"
.ListIndex = 0
End With
End Sub

[illogic]

Ok i got it working now, thanks for helping me out.

I actually don't know why exactly it didn't work when i first tried it out.
I just deleted the picture control and added a new one. renamed it to imgPreview and tried again.

Thanks for pointing out your idea with the two column combo box. That is also an alternative to think about.
So far i am satisfied with the result. It now works as intended.

There is still a lot for me to learn about VBA, so this was a major help to me! thanks again.

[gmaxey]

Good. gmaxey and gmayor are actually two different people on opposite sides of the world. Glad it works for you with either method.