Retrieve Image from Sheet to userform??

[sureshtrb]

Attached a sample code
need help in retrieving the images from worksheet to Userform
https://www.dropbox.com/s/nvghhjp8o83jwt0/Retrieve iMAGE.xlsm?dl=0

Please help
Trying for more than a week time.

 

[Domenic]

1.The temporary sheet "ImageCopies1" should not be deleted in the close function.

If ws.Name <> "Data" And ws.Name <> "ImageCopies1" Then ws.Delete

Your code will delete all sheets, except "Data" and "ImageCopies1". If this is your intent, the code is correct.

2.Same image is showing in both image controls in userform

When I test my portion of code, the first image control gets "image1" and the second image control gets "image2".

3.The temporary additional sheet to be deleted

I hadn't looked at your code for other event handlers. In taking a quick look now I didn't see a temporary sheet being added anywhere. Which temporary additional sheet are you referring to?

 

[sureshtrb]

Private Sub CBSearchResult_Change()

Dim FoundCell As RANGE


Application.ScreenUpdating = False


  If Me.CBSearchResult.Value = "" Then
        Me.FNO.Enabled = True
        
            If Me.CBSearchCatagory.Value = "Search by FNO" Or _
                Me.CBSearchCatagory.Value = "Search by IDNO" Or _
                Me.CBSearchCatagory.Value = "Search by TAGNO" Or _
                Me.CBSearchCatagory.Value = "Search by CUSTOMER" Or _
                Me.CBSearchCatagory.Value = "Search by VMANUF" Or _
                Me.CBSearchCatagory.Value = "Search by VSDJOBNO" Or _
                Me.CBSearchCatagory.Value = "Search by SIZE" And _
                Me.CBSearchResult = "" Then Exit Sub
                  Me.CBSearchResult.Visible = True
            End If
               If Me.CBSearchResult.ListIndex = 0 Then
                        Beep
                            Exit Sub
                End If
                Me.FNO.Value = Me.CBSearchResult.Value
            If Me.CBSearchCatagory.Value = "Search by FNO" And Me.FNO.Value = Me.CBSearchResult Then
                With CBSearchResult
                Application.ScreenUpdating = False
                        Set FoundCell = Cells.Find(What:=Me.CBSearchResult.Value, _
                                                            After:=Cells(1), _
                                                            LookIn:=xlValues, _
                                                            lookat:=xlWhole, _
                                                            SearchOrder:=xlByRows, _
                                                            SearchDirection:=xlPrevious, _
                                                            MatchCase:=False)
            If Not FoundCell Is Nothing Then
            Beep
    
Me.IDNO.Value = FoundCell.Offset(0, 1).Value
Me.TAGNO.Value = FoundCell.Offset(0, 2).Value
Me.CUSTOMER.Value = FoundCell.Offset(0, 3).Value
Me.VTYPE.Value = FoundCell.Offset(0, 4).Value
Me.JOBNO.Value = FoundCell.Offset(0, 5).Value
Me.RECDDATE.Value = FoundCell.Offset(0, 6).Value
Me.SIZE.Value = FoundCell.Offset(0, 7).Value
Me.UNIT.Value = FoundCell.Offset(0, 8).Value
Me.CLASS.Value = FoundCell.Offset(0, 9).Value
Me.MODL.Value = FoundCell.Offset(0, 10).Value
Me.VMANUF.Value = FoundCell.Offset(0, 11).Value
Me.LCLASS.Value = FoundCell.Offset(0, 12).Value
Me.CV.Value = FoundCell.Offset(0, 13).Value
Me.ATYPE.Value = FoundCell.Offset(0, 14).Value
Me.AMANUF.Value = FoundCell.Offset(0, 15).Value
Me.SERIALNO.Value = FoundCell.Offset(0, 16).Value
Me.TRAVEL.Value = FoundCell.Offset(0, 17).Value
Me.SUP.Value = FoundCell.Offset(0, 18).Value
Me.SUNIT.Value = FoundCell.Offset(0, 19).Value
Me.RANGE.Value = FoundCell.Offset(0, 20).Value
Me.ACTION.Value = FoundCell.Offset(0, 21).Value
Me.LOC.Value = FoundCell.Offset(0, 22).Value




'Picture1-Label Copy to userform
Dim wsImageCopies1 As Worksheet
Dim oImage As Image
Dim oShape As Shape
Dim oChart As Chart
Dim sTempFilename As String
Dim s As Double
Dim l As Double
Dim t As Double
Dim h As Double


'Assign a filename for the temporary image
sTempFilename = Environ("temp") & "\temp_" & Format(Now, "yy-mm-dd_hh-mm-ss") & ".jpg"


'Assign the "ImageCopies1" sheet to an object variable
Set wsImageCopies1 = ActiveWorkbook.Worksheets("ImageCopies1")


s = 100
t = 50
l = 24
h = 24


If FoundCell.Offset(0, 24).Value > "" Then
MultiPage1.Pages.Add
Dim lblCaption1 As MSForms.Label
            On Error GoTo Err_Clr
            Set lblCaption1 = MultiPage1.Pages(1).Controls.Add("Forms.label.1", "myLabelCaption")
        With lblCaption1
        .Font.Name = "Arial Black"
        .Font.SIZE = 14
        .TextAlign = fmTextAlignCenter
        .Width = s
        .Height = h
        .Left = l
        .Top = t + s
        .ForeColor = vbWhite
        .BackColor = &H800000
        .WordWrap = False
        .AutoSize = False
        .Enabled = True
        .Caption = FoundCell.Offset(0, 24).Value
        Me.Repaint
        End With
        
'Add and set the properties for an image control on the second page of the multipage control
Set oImage = Me.MultiPage1.Pages(1).Controls.Add("Forms.Image.1")
With oImage
    .Name = "image1"
    .Left = l
    .Top = t
    .Width = s
    .Height = s
End With


'Assign image1 to an object variable
Set oShape = wsImageCopies1.Shapes(MultiPage1.Pages(1).image1.Name)


'Add an empty chart
With wsImageCopies1.ChartObjects.Add(Left:=1, Top:=1, Width:=oShape.Width, Height:=oShape.Height)
    With .Chart
        'Copy the picture
        oShape.Copy
        'Paste the picture in the chart
        .Paste
        'Export the chart
        .Export sTempFilename
    End With
    'Load the exported file onto the image control
    oImage.Picture = LoadPicture(sTempFilename)
    'Delete the chart
    .Delete
    'Delete the temporary file
    Kill sTempFilename
End With
        
If FoundCell.Offset(0, 26).Value > "" Then
     MultiPage1.Pages().Value = 1
            Dim lblCaption2 As MSForms.Label
  On Error GoTo Err_Clr
            Set lblCaption2 = MultiPage1.Pages(1).Controls.Add("Forms.label.1", "myLabelCaption")
                With lblCaption2
                        .Font.Name = "Arial Black"
                        .Font.SIZE = 14
                        .TextAlign = fmTextAlignCenter
                        .Width = s
                        .Height = h
                        .Left = l + s + l
                        .Top = t + s
                        .ForeColor = vbWhite
                        .BackColor = &H800000
                        .WordWrap = False
                        .AutoSize = False
                        .Enabled = True
                        .Caption = FoundCell.Offset(0, 26).Value
                Me.Repaint
                End With


'Assign the "ImageCopies1" sheet to an object variable
Set wsImageCopies1 = ActiveWorkbook.Worksheets("ImageCopies")


'Add and set the properties for another image control on the second page of the multipage control
Set oImage = Me.MultiPage1.Pages(1).Controls.Add("Forms.Image.1")
With oImage
    .Name = "image2"
    .Left = l + s + l
    .Top = t
    .Width = s
    .Height = s
End With


'Assign image2 to an object variable
Set oShape = wsImageCopies1.Shapes(MultiPage1.Pages(1).Image2.Name)


'Add an empty chart
With wsImageCopies1.ChartObjects.Add(Left:=1, Top:=1, Width:=oShape.Width, Height:=oShape.Height)
    With .Chart
        'Copy the picture
        oShape.Copy
        'Paste the picture in the chart
        .Paste
        'Export the chart
        .Export sTempFilename
    End With
    'Load the exported file onto the image control
    oImage.Picture = LoadPicture(sTempFilename)
    'Delete the chart
    .Delete
    'Delete the temporary file
    Kill sTempFilename
End With


        
            End If
        End If
    End If


Application.ScreenUpdating = True
        
Err_Clr:
If Err <> 0 Then
    Err.Clear
                Resume Next
            End If
        End With
    End If
End Sub

copied your above code.
I maintain the imageCopies1 sheet (Temporary sheet) delete during closing time,
When i recall the image it says "script out of range" and the error in the line

Set wsImageCopies1 = ActiveWorkbook.Worksheets("ImageCopies1")

If i leave the imagecopies1 sheet without deleting, it works but getting the same image in both the image controls
I am confused where i am doing mistake as it works for you?

 

[Domenic]

In order to trouble shoot your code I would need a copy of your workbook. Unfortunately, as I have already mentioned, I don't download workbooks as a rule. If you need further help, I would suggest starting a new thread and someone may be willing to download and look at your workbook.

 

[sureshtrb]

Thanks for your support and will let you know if I found any other solution.
Thanks again

 

[sureshtrb]

In order to trouble shoot your code I would need a copy of your workbook. Unfortunately, as I have already mentioned, I don't download workbooks as a rule. If you need further help, I would suggest starting a new thread and someone may be willing to download and look at your workbook.

Solved and related link http://www.mrexcel.com/forum/excel-questions/846517-reference-variable-cell-image-other-sheet-2.html