Retrieve Image from Sheet to userform??

sureshtrb

Board Regular
Joined
Mar 24, 2013
Messages
105
Code:
With MultiPage1.Pages(1)       Dim pic1 As Image
        Set pic1 = .Controls.Add("Forms.image.1")
            pic1.Name = "image1"
            pic1.Width = s
            pic1.Height = s
            pic1.Top = t
            pic1.Left = l
Application.ScreenUpdating = True
End With
'Photo -1
'=====================================================================================
'???
'Here is the place I Need Code to copy the Picture (Shapes) from Worksheet to Userform
'=====================================================================================
        
             'NEED
                    'HELP
                            'HERE
                                    'PLEASE
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,003
Try...

<font face=Calibri><SPAN style="color:#007F00">'Declare the variables</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> wsSource <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> oPic <SPAN style="color:#00007F">As</SPAN> Picture<br><SPAN style="color:#00007F">Dim</SPAN> oImage <SPAN style="color:#00007F">As</SPAN> Image<br><SPAN style="color:#00007F">Dim</SPAN> oChart <SPAN style="color:#00007F">As</SPAN> Chart<br><SPAN style="color:#00007F">Dim</SPAN> sTempFilename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> t <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br><br><SPAN style="color:#007F00">'Assign values to variables t and s</SPAN><br><SPAN style="color:#007F00">'t = ???</SPAN><br><SPAN style="color:#007F00">'s = ???</SPAN><br><br><SPAN style="color:#007F00">'Assign a variable a temporary filename for the exported image</SPAN><br>sTempFilename = Environ("temp") & "\temp_" & Format(Now, "yy-mm-dd_hh-mm-ss") & ".jpg"<br><br><SPAN style="color:#007F00">'Assign to an object variable the sheet containing the picture (change the sheet name accordingly)</SPAN><br><SPAN style="color:#00007F">Set</SPAN> wsSource = ActiveWorkbook.Worksheets("Sheet1")<br><br><SPAN style="color:#007F00">'Assign to an object variable the picture (change the name of the picture accordingly)</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oPic = wsSource.Pictures("Picture 1")<br><br><SPAN style="color:#007F00">'Add and set the properties for an image control on the second page of the MultiPage control</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oImage = Me.MultiPage1.Pages(1).Controls.Add("Forms.Image.1")<br><SPAN style="color:#00007F">With</SPAN> oImage<br>    .Name = "image1"<br>    .Left = l<br>    .Top = t<br>    .Width = s<br>    .Height = s<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Create an empty chart</SPAN><br><SPAN style="color:#00007F">With</SPAN> wsSource.ChartObjects.Add(Left:=1, Top:=1, Width:=oPic.Width, Height:=oPic.Height)<br>    <SPAN style="color:#00007F">With</SPAN> .Chart<br>        <SPAN style="color:#007F00">'Copy the picture</SPAN><br>        oPic.Copy<br>        <SPAN style="color:#007F00">'Paste the picture in the chart</SPAN><br>        .Paste<br>        <SPAN style="color:#007F00">'Export the chart</SPAN><br>        .Export sTempFilename<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#007F00">'Load the exported file onto the image control</SPAN><br>    oImage.Picture = LoadPicture(sTempFilename)<br>    <SPAN style="color:#007F00">'Delete the chart</SPAN><br>    .Delete<br>    <SPAN style="color:#007F00">'Delete the temporary file</SPAN><br>    Kill sTempFilename<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN></FONT>

Hope this helps!
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,003
Can you post the code that you tried?
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,003
Sorry, but I don't download workbooks. I should have mentioned it in my original reply.
 

sureshtrb

Board Regular
Joined
Mar 24, 2013
Messages
105
Sorry for delay in responding.
Userform Code:

Code:
Private Sub CBSearchCatagory_AfterUpdate()


Me.CBSearchResult.Visible = True
If Me.CBSearchCatagory.Value = "Search by FNO" Then
Dim v, e
Me.CBSearchResult.Clear
With Sheets("Data").RANGE("A3:A200000")
    v = .Value
End With
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
        If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then Me.CBSearchResult.List = Application.Transpose(.keys)
End With
End If
End Sub
Private Sub CBSearchCatagory_DropButt*******()
Me.CBSearchResult.Visible = True
End Sub
Private Sub CBSearchResult_Change()
Dim FoundCell As RANGE
  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 s, l, t, h As Long
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
        
'With MultiPage1.Pages(1)
 '      Dim pic1 As Image
  '      Set pic1 = .Controls.Add("Forms.image.1")
   '         pic1.Name = "image1"
    '        pic1.Width = s
     '       pic1.Height = s
      '      pic1.Top = t
       '     pic1.Left = l
'Application.ScreenUpdating = True
'End With


'Photo -1
'=====================================================================================
'???
'Here is the place I Need Code to copy the Picture (Shapes) from Worksheet to Userform
'=====================================================================================
        
             'NEED
                    'HELP
                            'HERE
                                    'PLEASE
        
'Declare the variables
Dim wsSource As Worksheet
Dim oPic As Picture
Dim oImage As Image
Dim oChart As Chart
Dim sTempFilename As String
'Dim t As Double
'Dim s As Double


Application.ScreenUpdating = False


'Assign values to variables t and s
't = ???
's = ???


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


'Assign to an object variable the sheet containing the picture (change the sheet name accordingly)
Set wsSource = ActiveWorkbook.Worksheets("Data")


'Assign to an object variable the picture (change the name of the picture accordingly)
Set oPic = wsSource.Pictures("Picture 1")


'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


'Create an empty chart
With wsSource.ChartObjects.Add(Left:=1, Top:=1, Width:=oPic.Width, Height:=oPic.Height)
    With .Chart
        'Copy the picture
        oPic.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


Application.ScreenUpdating = False


        
        
        
        
        
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
'With MultiPage1.Pages(1)
 '      Dim pic2 As Image
  '      Set pic2 = .Controls.Add("Forms.image.1")
   '         pic2.Name = "image2"
    '        pic2.Width = s
     '       pic2.Height = s
      '      pic2.Top = t
       '     pic2.Left = l + s + l
'Application.ScreenUpdating = True
'End With








'Photo -2
'=====================================================================================
'???
'Here is the place I Need Code to copy the Picture (Shapes) from Worksheet to Userform
'=====================================================================================
     'NEED
            'HELP
                    'HERE
                            'PLEASE
        
        
        
            End If
        End If
    End If


Err_Clr:
If Err <> 0 Then
    Err.Clear
                Resume Next
            End If
        End With
    End If
End Sub




Private Sub CommandButton1_Click()
Dim nextrow As Integer


Dim dDate As Date


nextrow = WorksheetFunction.CountA(Sheets("Data").RANGE("A:A")) + 1


Sheets("Data").Cells(nextrow, 1) = Me.FNO.Value
Sheets("Data").Cells(nextrow, 2) = Me.IDNO.Value
Sheets("Data").Cells(nextrow, 3) = Me.TAGNO.Value
Sheets("Data").Cells(nextrow, 4) = Me.CUSTOMER.Value
Sheets("Data").Cells(nextrow, 5) = Me.VTYPE.Value
Sheets("Data").Cells(nextrow, 6) = Me.JOBNO.Value
Sheets("Data").Cells(nextrow, 7) = Me.RECDDATE.Value
Sheets("Data").Cells(nextrow, 8) = Me.SIZE.Value
Sheets("Data").Cells(nextrow, 9) = Me.UNIT.Value
Sheets("Data").Cells(nextrow, 10) = Me.CLASS.Value
Sheets("Data").Cells(nextrow, 11) = Me.MODL.Value
Sheets("Data").Cells(nextrow, 12) = Me.VMANUF.Value
Sheets("Data").Cells(nextrow, 13) = Me.LCLASS.Value
Sheets("Data").Cells(nextrow, 14) = Me.CV.Value
Sheets("Data").Cells(nextrow, 15) = Me.ATYPE.Value
Sheets("Data").Cells(nextrow, 16) = Me.AMANUF.Value
Sheets("Data").Cells(nextrow, 17) = Me.SERIALNO.Value
Sheets("Data").Cells(nextrow, 18) = Me.TRAVEL.Value
Sheets("Data").Cells(nextrow, 19) = Me.SUP.Value
Sheets("Data").Cells(nextrow, 20) = Me.SUNIT.Value
Sheets("Data").Cells(nextrow, 21) = Me.RANGE.Value
Sheets("Data").Cells(nextrow, 22) = Me.ACTION.Value
Sheets("Data").Cells(nextrow, 23) = Me.LOC.Value


'Picture 1 Copy to Worksheet
    Dim wsRpt1 As Worksheet
    Dim shpToCopy1 As Shape
    Dim shpPasted1 As Shape
    
        Set wsRpt1 = Worksheets("Data")
        On Error GoTo Err_Clr
    If MultiPage1.Pages(1).image1.Picture Is Nothing Then
       MsgBox "Load the picture to the Userform before copying to worksheet"
        Exit Sub
        End If
    Set shpToCopy1 = Worksheets("ImageCopies1").Shapes(MultiPage1.Pages(1).image1.Name)
    shpToCopy1.Copy
    wsRpt1.Paste
    With wsRpt1
        Set shpPasted1 = .Shapes(MultiPage1.Pages(1).image1.Name)
        With shpPasted1
            .Name = "New Picture1"
            .LockAspectRatio = msoFalse
            .Top = wsRpt1.Cells(nextrow, "X").Top
            .Left = wsRpt1.Cells(nextrow, "X").Left


            .Height = wsRpt1.Cells(nextrow, "X").Height
            .Width = wsRpt1.Cells(nextrow, "X").Width
        End With
    End With
    
'Picture 2 Copy to Worksheet
    Dim wsRpt2 As Worksheet
    Dim shpToCopy2 As Shape
    Dim shpPasted2 As Shape
        Set wsRpt2 = Worksheets("Data")
        On Error GoTo Err_Clr
    If MultiPage1.Pages(1).Image2.Picture Is Nothing Then
        MsgBox "Load the picture to the Userform before copying to worksheet."
        Exit Sub
    End If
    Set shpToCopy2 = Worksheets("ImageCopies2").Shapes(MultiPage1.Pages(1).Image2.Name)
    shpToCopy2.Copy
    wsRpt2.Paste
    With wsRpt2
            Set shpPasted2 = .Shapes(MultiPage1.Pages(1).Image2.Name)
        With shpPasted2
                .Name = "New Picture2"
                .LockAspectRatio = msoFalse
                .Top = wsRpt2.Cells(nextrow, "Z").Top
                .Left = wsRpt2.Cells(nextrow, "Z").Left
                .Height = wsRpt2.Cells(nextrow, "Z").Height
                .Width = wsRpt2.Cells(nextrow, "Z").Width
            With Selection
            End With
        End With
    End With
    Application.ScreenUpdating = True


Err_Clr:
If Err <> 0 Then
Err.Clear
Resume Next
End If


Me.CommandButton2.Visible = False
Me.CommandButton1.Visible = False


End Sub


Private Sub CommandButton2_Click()
Me.MultiPage1.Pages.Add
MultiPage1.Pages(1).Enabled = True
Me.MultiPage1.Value = 1
line323232:
Dim s, l, t, h As Long
s = 100
t = 50
l = 24
h = 24
'Photo -1
With MultiPage1.Pages(1)


Dim wsInit1  As Worksheet
Dim strInitDir1 As String
Dim strPicPathFile1 As String
Dim shpPicture1 As Shape
Dim wsImages1 As Worksheet
    
    Dim pic As Image
    Set pic = .Controls.Add("Forms.image.1")
    With pic
            .Name = "image1"
            .Width = s
            .Height = s
            .Top = t
            .Left = l
        End With
        
Application.ScreenUpdating = False
Set wsInit1 = ActiveSheet
strInitDir1 = CurDir


        With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = strInitDir1
.Filters.Clear
        .AllowMultiSelect = False
        .ButtonName = "Submit"
        .Title = "Select Photo-1"
        .Filters.Add "Image1", "*.gif; *.jpg; *.jpeg; *.gif;*.jpe,*.jfif;*.jpe. 1"
        If .Show = -1 Then
            MultiPage1.Pages(1).image1.PictureSizeMode = fmPictureSizeModeZoom
            MultiPage1.Pages(1).image1.Picture = LoadPicture(.SelectedItems(1))
End If
On Error Resume Next
strPicPathFile1 = .SelectedItems(1)
End With
    
On Error Resume Next
Set wsImages1 = Nothing
Set wsImages1 = Worksheets("ImageCopies1")
On Error GoTo line323232
If wsImages1 Is Nothing Then
Set wsImages1 = Sheets.Add(After:=Sheets(Sheets.Count))
wsImages1.Name = "ImageCopies1"
wsInit1.Activate
Else
On Error Resume Next
wsImages1.Shapes(MultiPage1.Pages(1).image1.Name).Delete
On Error GoTo line323232
End If
     
With wsImages1
Set shpPicture1 = .Shapes.AddPicture _
                        (Filename:=strPicPathFile1, _
                        LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, _
                        Left:=1, Top:=1, _
                        Width:=-1, Height:=-1)
With shpPicture1
.Name = MultiPage1.Pages(1).image1.Name
.Width = MultiPage1.Pages(1).image1.Width
End With
End With
    
With MultiPage1.Pages(1).image1
.Picture = LoadPicture(strPicPathFile1)
.Width = wsImages1.Shapes(MultiPage1.Pages(1).image1.Name).Width
.Height = wsImages1.Shapes(MultiPage1.Pages(1).image1.Name).Height
End With
ChDir CurDir
Application.ScreenUpdating = True
    
            Dim lblCaption1 As MSForms.Label
            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
            Dim myValue As Variant
            myValue = InputBox("Give me some input")
            lblCaption1.Caption = myValue
Dim nextrow As Integer
nextrow = WorksheetFunction.CountA(Sheets("Data").RANGE("A:A")) + 1
Sheets("Data").Cells(nextrow, "Y") = lblCaption1.Caption


            
'Photo -2
line323233:
Dim wsInit2  As Worksheet
Dim strInitDir2 As String
Dim strPicPathFile2 As String
Dim shpPicture2 As Shape
Dim wsImages2 As Worksheet
                Dim msg As String
                Dim ireplly As Integer
                ireplly = MsgBox("Add Another Photo?", vbQuestion + vbOKCancel)
        Select Case ireplly
        Case vbCancel
                Dim iPage As Integer
                Dim i As Long
                iPage = MultiPage1.Pages.Count - 1
        For i = 0 To iPage
                MultiPage1.Pages(i).Enabled = True
        Next
                Me.MultiPage1.Pages(1).Enabled = True
                Me.MultiPage1.Value = 1
                                    CBAddImage1.Visible = False
    Exit Sub
        Case vbOK
                MultiPage1.Pages(1).Enabled = True
                MultiPage1.Pages(1).Enabled = True
                Me.MultiPage1.Value = 1
            With MultiPage1.Pages(1)
        Dim pic2 As Image
        Set pic2 = .Controls.Add("Forms.image.1")
            pic2.Name = "image2"
            pic2.Width = s
            pic2.Height = s
            pic2.Top = t
            pic2.Left = l + s + l
Application.ScreenUpdating = False
Set wsInit2 = ActiveSheet
strInitDir2 = CurDir


        With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = strInitDir2
.Filters.Clear
                .AllowMultiSelect = False
                .ButtonName = "Submit"
                .Title = "Select Photo-2"
                .Filters.Add "Image2", "*.gif; *.jpg; *.jpeg; *.gif;*.jpe,*.jfif;*.jpe. 1"
        If .Show = -1 Then
                        MultiPage1.Pages(1).Image2.PictureSizeMode = fmPictureSizeModeZoom
                        MultiPage1.Pages(1).Image2.Picture = LoadPicture(.SelectedItems(1))
End If
        
strPicPathFile2 = .SelectedItems(1)
End With


On Error Resume Next
Set wsImages2 = Nothing
Set wsImages2 = Worksheets("ImageCopies2")
On Error GoTo line323233
If wsImages2 Is Nothing Then
Set wsImages2 = Sheets.Add(After:=Sheets(Sheets.Count))
wsImages2.Name = "ImageCopies2"
wsInit2.Activate
Else
On Error Resume Next
wsImages2.Shapes(MultiPage1.Pages(1).Image2.Name).Delete
On Error GoTo line323233
End If
     
With wsImages2
Set shpPicture2 = .Shapes.AddPicture _
                        (Filename:=strPicPathFile2, _
                        LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, _
                        Left:=1, Top:=1, _
                        Width:=-1, Height:=-1)
With shpPicture2
.Name = MultiPage1.Pages(1).Image2.Name
.Width = MultiPage1.Pages(1).Image2.Width
End With
End With
    
With MultiPage1.Pages(1).Image2
.Picture = LoadPicture(strPicPathFile2)
.Width = wsImages2.Shapes(MultiPage1.Pages(1).Image2.Name).Width
.Height = wsImages2.Shapes(MultiPage1.Pages(1).Image2.Name).Height
End With
ChDir CurDir
Application.ScreenUpdating = True


            Dim lblCaption2 As MSForms.Label
            Set lblCaption2 = MultiPage1.Pages(1).Controls.Add("Forms.label.1", "myLabelCaption")
                        lblCaption2.Font.Name = "Arial Black"
                        lblCaption2.Font.SIZE = 14
                        lblCaption2.TextAlign = fmTextAlignCenter
                        lblCaption2.Width = s
                        lblCaption2.Height = h
                        lblCaption2.Left = l + s + l
                        lblCaption2.Top = t + s
                        lblCaption2.ForeColor = vbWhite
                        lblCaption2.BackColor = &H800000
                        lblCaption2.WordWrap = False
                        lblCaption2.AutoSize = False
                        lblCaption2.Enabled = True
                myValue = InputBox("Give me some input")
                lblCaption2.Caption = myValue
Sheets("Data").Cells(nextrow, "AA") = lblCaption2.Caption
                End With
            End Select
        End With
    End With


End Sub




Private Sub UserForm_Initialize()
Me.CBSearchResult.Visible = False
Me.CBSearchCatagory.AddItem "Search by FNO"
'Me.CBSearchCatagory.AddItem "Search by IDNO"
'Me.CBSearchCatagory.AddItem "Search by TAGNO"
'Me.CBSearchCatagory.AddItem "Search by CUSTOMER"
'Me.CBSearchCatagory.AddItem "Search by VMANUF"
'Me.CBSearchCatagory.AddItem "Search by VSDJOBNO"
'Me.CBSearchCatagory.AddItem "Search by SIZE"


Me.UNIT.AddItem "INCH"
Me.UNIT.AddItem "MM"


Me.LOC.AddItem "A"
Me.LOC.AddItem "B"


Me.SUNIT.AddItem "psi"
Me.SUNIT.AddItem "bar"
End Sub
Private Sub cmdClose_Click()
 If MsgBox("Do you Want to Close?", vbOKCancel) = vbCancel Then Exit Sub
Unload Me
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Data" Then ws.Delete
Next
Application.DisplayAlerts = True


ActiveWorkbook.Save
'Application.Quit
End Sub
Module:
Code:
Sub SHOWFORM_Click()UserForm1.Show
End Sub
Hope its clear
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,003
Untested, try...

<font face=Calibri><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> CBSearchResult_Change()<br><br><SPAN style="color:#00007F">Dim</SPAN> FoundCell <SPAN style="color:#00007F">As</SPAN> Range<br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br><br>  <SPAN style="color:#00007F">If</SPAN> Me.CBSearchResult.Value = "" <SPAN style="color:#00007F">Then</SPAN><br>        Me.FNO.Enabled = <SPAN style="color:#00007F">True</SPAN><br>        <br>            <SPAN style="color:#00007F">If</SPAN> Me.CBSearchCatagory.Value = "Search by FNO" Or _<br>                Me.CBSearchCatagory.Value = "Search by IDNO" Or _<br>                Me.CBSearchCatagory.Value = "Search by TAGNO" Or _<br>                Me.CBSearchCatagory.Value = "Search by CUSTOMER" Or _<br>                Me.CBSearchCatagory.Value = "Search by VMANUF" Or _<br>                Me.CBSearchCatagory.Value = "Search by VSDJOBNO" Or _<br>                Me.CBSearchCatagory.Value = "Search by SIZE" And _<br>                Me.CBSearchResult = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                  Me.CBSearchResult.Visible = <SPAN style="color:#00007F">True</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>               <SPAN style="color:#00007F">If</SPAN> Me.CBSearchResult.ListIndex = 0 <SPAN style="color:#00007F">Then</SPAN><br>                        Beep<br>                            <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>                Me.FNO.Value = Me.CBSearchResult.Value<br>            <SPAN style="color:#00007F">If</SPAN> Me.CBSearchCatagory.Value = "Search by FNO" And Me.FNO.Value = Me.CBSearchResult <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">With</SPAN> CBSearchResult<br>                Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>                        <SPAN style="color:#00007F">Set</SPAN> FoundCell = Cells.Find(What:=Me.CBSearchResult.Value, _<br>                                                            After:=Cells(1), _<br>                                                            LookIn:=xlValues, _<br>                                                            lookat:=xlWhole, _<br>                                                            SearchOrder:=xlByRows, _<br>                                                            SearchDirection:=xlPrevious, _<br>                                                            MatchCase:=False)<br>            <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> FoundCell <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            Beep<br>    <br>Me.IDNO.Value = FoundCell.Offset(0, 1).Value<br>Me.TAGNO.Value = FoundCell.Offset(0, 2).Value<br>Me.CUSTOMER.Value = FoundCell.Offset(0, 3).Value<br>Me.VTYPE.Value = FoundCell.Offset(0, 4).Value<br>Me.JOBNO.Value = FoundCell.Offset(0, 5).Value<br>Me.RECDDATE.Value = FoundCell.Offset(0, 6).Value<br>Me.Size.Value = FoundCell.Offset(0, 7).Value<br>Me.UNIT.Value = FoundCell.Offset(0, 8).Value<br>Me.CLASS.Value = FoundCell.Offset(0, 9).Value<br>Me.MODL.Value = FoundCell.Offset(0, 10).Value<br>Me.VMANUF.Value = FoundCell.Offset(0, 11).Value<br>Me.LCLASS.Value = FoundCell.Offset(0, 12).Value<br>Me.CV.Value = FoundCell.Offset(0, 13).Value<br>Me.ATYPE.Value = FoundCell.Offset(0, 14).Value<br>Me.AMANUF.Value = FoundCell.Offset(0, 15).Value<br>Me.SERIALNO.Value = FoundCell.Offset(0, 16).Value<br>Me.TRAVEL.Value = FoundCell.Offset(0, 17).Value<br>Me.SUP.Value = FoundCell.Offset(0, 18).Value<br>Me.SUNIT.Value = FoundCell.Offset(0, 19).Value<br>Me.Range.Value = FoundCell.Offset(0, 20).Value<br>Me.Action.Value = FoundCell.Offset(0, 21).Value<br>Me.Loc.Value = FoundCell.Offset(0, 22).Value<br><br><br><SPAN style="color:#007F00">'Picture1-Label Copy to userform</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> wsImageCopies1 <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> oImage <SPAN style="color:#00007F">As</SPAN> Image<br><SPAN style="color:#00007F">Dim</SPAN> oShape <SPAN style="color:#00007F">As</SPAN> Shape<br><SPAN style="color:#00007F">Dim</SPAN> oChart <SPAN style="color:#00007F">As</SPAN> Chart<br><SPAN style="color:#00007F">Dim</SPAN> sTempFilename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> l <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> t <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> h <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Double</SPAN><br><br><SPAN style="color:#007F00">'Assign a filename for the temporary image</SPAN><br>sTempFilename = Environ("temp") & "\temp_" & Format(Now, "yy-mm-dd_hh-mm-ss") & ".jpg"<br><br><SPAN style="color:#007F00">'Assign the "ImageCopies1" sheet to an object variable</SPAN><br><SPAN style="color:#00007F">Set</SPAN> wsImageCopies1 = ActiveWorkbook.Worksheets("ImageCopies1")<br><br>s = 100<br>t = 50<br>l = 24<br>h = 24<br><br><SPAN style="color:#00007F">If</SPAN> FoundCell.Offset(0, 24).Value > "" <SPAN style="color:#00007F">Then</SPAN><br>MultiPage1.Pages.Add<br><SPAN style="color:#00007F">Dim</SPAN> lblCaption1 <SPAN style="color:#00007F">As</SPAN> MSForms.Label<br>            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Clr<br>            <SPAN style="color:#00007F">Set</SPAN> lblCaption1 = MultiPage1.Pages(1).Controls.Add("Forms.label.1", "myLabelCaption")<br>        <SPAN style="color:#00007F">With</SPAN> lblCaption1<br>        .Font.Name = "Arial Black"<br>        .Font.Size = 14<br>        .TextAlign = fmTextAlignCenter<br>        .Width = s<br>        .Height = h<br>        .Left = l<br>        .Top = t + s<br>        .ForeColor = vbWhite<br>        .BackColor = &H800000<br>        .WordWrap = <SPAN style="color:#00007F">False</SPAN><br>        .AutoSize = <SPAN style="color:#00007F">False</SPAN><br>        .Enabled = <SPAN style="color:#00007F">True</SPAN><br>        .Caption = FoundCell.Offset(0, 24).Value<br>        Me.Repaint<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <br><SPAN style="color:#007F00">'Add and set the properties for an image control on the second page of the multipage control</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oImage = Me.MultiPage1.Pages(1).Controls.Add("Forms.Image.1")<br><SPAN style="color:#00007F">With</SPAN> oImage<br>    .Name = "image1"<br>    .Left = l<br>    .Top = t<br>    .Width = s<br>    .Height = s<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Assign image1 to an object variable</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oShape = wsImageCopies1.Shapes(MultiPage1.Pages(1).image1.Name)<br><br><SPAN style="color:#007F00">'Add an empty chart</SPAN><br><SPAN style="color:#00007F">With</SPAN> wsImageCopies1.ChartObjects.Add(Left:=1, Top:=1, Width:=oShape.Width, Height:=oShape.Height)<br>    <SPAN style="color:#00007F">With</SPAN> .Chart<br>        <SPAN style="color:#007F00">'Copy the picture</SPAN><br>        oShape.Copy<br>        <SPAN style="color:#007F00">'Paste the picture in the chart</SPAN><br>        .Paste<br>        <SPAN style="color:#007F00">'Export the chart</SPAN><br>        .Export sTempFilename<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#007F00">'Load the exported file onto the image control</SPAN><br>    oImage.Picture = LoadPicture(sTempFilename)<br>    <SPAN style="color:#007F00">'Delete the chart</SPAN><br>    .Delete<br>    <SPAN style="color:#007F00">'Delete the temporary file</SPAN><br>    Kill sTempFilename<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <br><SPAN style="color:#00007F">If</SPAN> FoundCell.Offset(0, 26).Value > "" <SPAN style="color:#00007F">Then</SPAN><br>     MultiPage1.Pages().Value = 1<br>            <SPAN style="color:#00007F">Dim</SPAN> lblCaption2 <SPAN style="color:#00007F">As</SPAN> MSForms.Label<br>  <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Clr<br>            <SPAN style="color:#00007F">Set</SPAN> lblCaption2 = MultiPage1.Pages(1).Controls.Add("Forms.label.1", "myLabelCaption")<br>                <SPAN style="color:#00007F">With</SPAN> lblCaption2<br>                        .Font.Name = "Arial Black"<br>                        .Font.Size = 14<br>                        .TextAlign = fmTextAlignCenter<br>                        .Width = s<br>                        .Height = h<br>                        .Left = l + s + l<br>                        .Top = t + s<br>                        .ForeColor = vbWhite<br>                        .BackColor = &H800000<br>                        .WordWrap = <SPAN style="color:#00007F">False</SPAN><br>                        .AutoSize = <SPAN style="color:#00007F">False</SPAN><br>                        .Enabled = <SPAN style="color:#00007F">True</SPAN><br>                        .Caption = FoundCell.Offset(0, 26).Value<br>                Me.Repaint<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Add and set the properties for another image control on the second page of the multipage control</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oImage = Me.MultiPage1.Pages(1).Controls.Add("Forms.Image.1")<br><SPAN style="color:#00007F">With</SPAN> oImage<br>    .Name = "image2"<br>    .Left = l + s + l<br>    .Top = t<br>    .Width = s<br>    .Height = s<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'Assign image2 to an object variable</SPAN><br><SPAN style="color:#00007F">Set</SPAN> oShape = wsImageCopies1.Shapes(MultiPage1.Pages(1).image2.Name)<br><br><SPAN style="color:#007F00">'Add an empty chart</SPAN><br><SPAN style="color:#00007F">With</SPAN> wsImageCopies1.ChartObjects.Add(Left:=1, Top:=1, Width:=oShape.Width, Height:=oShape.Height)<br>    <SPAN style="color:#00007F">With</SPAN> .Chart<br>        <SPAN style="color:#007F00">'Copy the picture</SPAN><br>        oShape.Copy<br>        <SPAN style="color:#007F00">'Paste the picture in the chart</SPAN><br>        .Paste<br>        <SPAN style="color:#007F00">'Export the chart</SPAN><br>        .Export sTempFilename<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#007F00">'Load the exported file onto the image control</SPAN><br>    oImage.Picture = LoadPicture(sTempFilename)<br>    <SPAN style="color:#007F00">'Delete the chart</SPAN><br>    .Delete<br>    <SPAN style="color:#007F00">'Delete the temporary file</SPAN><br>    Kill sTempFilename<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>        <br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>        <br>Err_Clr:<br><SPAN style="color:#00007F">If</SPAN> Err <> 0 <SPAN style="color:#00007F">Then</SPAN><br>    Err.Clear<br>                <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Does this help?
 

sureshtrb

Board Regular
Joined
Mar 24, 2013
Messages
105
Appreciated.
It starts working with following issues.
1.The temporary sheet "ImageCopies1" should not be deleted in the close function.
Code:
If ws.Name <> "Data" And ws.Name <> "ImageCopies1" Then ws.Delete
2.Same image is showing in both image controls in userform
3.The temporary additional sheet to be deleted
 

Forum statistics

Threads
1,081,617
Messages
5,360,044
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top