Display a Range of Cells from a Worksheet on a Userform

[kgallego]

I would like to display a range of cells from a Worksheet on a Userform.


Worksheets("Pretty Picture") from Range (J2:M35)

It needs to be in the form of a picture, not the values of the cell. I was thinking that I could insert a picture on my userform and define the range as some type of object as the picture, but I have no idea how to code it. Does anyone know how i can do this?

Thanks,

Kelsey

 

[Jaafar Tribak]

Hi and welcome to the board.

First of all the form initialize syntax is incorrect.

UserForm_Initialize

NOT

UserForm[COLOR=Red][U][B]1[/B][/U][/COLOR]_Initialize

then the code you have assumes the range picture is dispalayed on an image control not directly on the userform...so you must add an image control to your form named Image1.

Needless to say that the code refers to a named range so you have to check if there is such named range as well.

 

[JPiLLa]

Thanks Jaafar...and that is exactly what I tried the first time, however, when I do that I get a Run-time error '424': Object Required error pop up at the end of the Function for PastePicture.

I have attached the part of the code that when I step through it, it errors out. Any ideas on why this would happen?

Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

'Some pointers
Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

'Convert the type of picture requested from the xl constant to the API constant
lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

'Check if the clipboard contains the required format
hPicAvail = IsClipboardFormatAvailable(lPicType)

If hPicAvail <> 0 Then
    'Get access to the clipboard
    h = OpenClipboard(0&)

    If h > 0 Then
        'Get a handle to the image data
        hPtr = GetClipboardData(lPicType)

        'Create our own copy of the image on the clipboard, in the appropriate format.
        If lPicType = CF_BITMAP Then
            hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
        Else
            hCopy = CopyEnhMetaFile(hPtr, vbNullString)
        End If

        'Release the clipboard to other programs
        h = CloseClipboard

        'If we got a handle to the image, convert it into a Picture object and return it
        If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
    End If
End If

[B][COLOR=Red]End Function[/COLOR][/B]

 

[JPiLLa]

Please let me know if you would like me to send you my .xls file if it would be easier. Thanks!

 

[Jaafar Tribak]

Please let me know if you would like me to send you my .xls file if it would be easier. Thanks!

Yes that's fine.

 

[Jaafar Tribak]

I took a look at the workbook you sent me and found that you are getting that error simply because you forgot to add an image control to the userform.

If you want to display the range directly on the userform then just change the code in the userform from :

Private Sub UserForm_Initialize()
    Worksheets("Sheet1").Range("Named_Range").CopyPicture
    [B][COLOR=Red]Set Image1.Picture = PastePicture(xlPicture)[/COLOR][/B]
End Sub

To

Private Sub UserForm_Initialize()
    Worksheets("Sheet1").Range("Named_Range").CopyPicture
  [B][COLOR=Red]  Set Me.Picture = PastePicture(xlPicture)[/COLOR][/B]
End Sub

 

[JPiLLa]

Thanks Jaafar, that worked to get the named range of cells to display in the command button popup. However, the displayed range picture is a lot smaller than the window, and even smaller than the formatting in the named range itself when you look at it in excel.

If you test this on the workbook I sent you, you will notice the words test show up, but they are very small.

Is there anyway to fix that, or autoformat to fit?

 

[Jaafar Tribak]

Hi JpiLLa,

This is in response to your PM.

I couldn't replicate the problem...the displayed range picture is exactly the same size as that of the source range.

You could however temporarly increase the named range font size to increase the displaed image as follows : (experiment with the font size increasing value until you find the satisfactory size)

Private Sub UserForm_Initialize()

    Dim lInitFontSize As Byte
    
    With Worksheets("Sheet1").Range("Named_Range")
        lInitFontSize = .Font.Size
        .Font.Size = lInitFontSize [COLOR=Red][B]+ 8[/B][/COLOR] 'change this value as required.
        .CopyPicture
        .Font.Size = lInitFontSize
    End With
    Set Me.Picture = PastePicture(xlPicture)
    
End Sub

You may also want to adjust the size of the form.