Reference to variable Cell Image to Other sheet

S

sureshtrb

Board Regular
Joined
Mar 24, 2013
Messages
106
Recalling data in userform from excel saved data, data works and image (Saved in cell) also works if I refer
Code: 
Set CopyImage1 = Worksheets("Data").Range("QW14")
I don't want to refer a particular cell the range should be variable like
Code: 
Set CopyImage1 = Worksheets("Data").Range(Foundcell.offset(0,464))
Unable to achieve this.
Any help is appreciated.
Thanks
 
Sort by date Sort by votes
Where's the code that uses CopyImage1?
 
Upvote 0

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Part of the code:
Code: 
Private Sub btnSearch_Click()Call ClearClipboard
            Me.btnSearch.Visible = True
            Me.CBSearchCatagory.Visible = True
            Me.CBSearchResult.Visible = True
            Me.cmdUpdate.Visible = True
            Me.cmdAdd.Visible = True
Dim FoundCell As Range
    If Me.CBSearchResult.Value = "" Then
        Me.tbCVCNo.Enabled = True
    With Me.CBSearchResult
        End With
            If Me.CBSearchCatagory.Value = "Search by CVC Number" Or _
                Me.CBSearchCatagory.Value = "Search by Nasico UID Number" Or _
                Me.CBSearchCatagory.Value = "Search by Tag Number" Or _
                Me.CBSearchCatagory.Value = "Search by Customer" Or _
                Me.CBSearchCatagory.Value = "Search by Valve Manufacturer" Or _
                Me.CBSearchCatagory.Value = "Search by Job Number" And _
                Me.CBSearchResult = "" Then Exit Sub
                Me.CBSearchResult.Visible = True
            End If
                If Me.CBSearchResult.ListIndex = 0 Then
                        Beep
                            Exit Sub
                End If
            If Me.CBSearchCatagory.Value = "Search by CVC Number" And Me.tbCVCNo.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.tbUIDNO.Value = FoundCell.Offset(0, 1).Value
Me.tbTAGNO.Value = FoundCell.Offset(0, 2).Value
Me.tbCUSTOMER.Value = FoundCell.Offset(0, 3).Value
'...............
'........
'......
'...


If FoundCell.Offset(0, 463).Value = "AFO" Then Me.OptionButton72.Value = True
If FoundCell.Offset(0, 463).Value = "AFC" Then Me.OptionButton73.Value = True
  
  
  Call ClearClipboard
           'Picture1-Comment Copy to userform
'Picture1-Label Copy to userform
Dim wsImageCopies1, wsinit1 As Worksheet
Dim oImage As image
Dim oShape, CopyImage1, PasteImage1 As shape
Dim oChart As Chart
Dim sTempFilename1, strInitDir1 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
sTempFilename1 = Environ("temp") & "\temp_" & Format(Now, "yy-mm-dd_hh-mm-ss") & ".jpg"


'Dim s, l, t, h As Long
s = 260
t = 100
l = 24
h = 24




If FoundCell.Offset(0, 484).Text > 0 Then


Set wsinit1 = ActiveSheet
strInitDir1 = CurDir   'Optional: Save directory so can return to it.


Call ClearClipboard


'Test if "ImageCopies" worksheet exists and if not then add it
On Error Resume Next
Set wsImageCopies1 = Nothing  'Initialize first
Set wsImageCopies1 = Worksheets("ImageCopies1")
If wsImageCopies1 Is Nothing Then
Set wsImageCopies1 = Sheets.Add(After:=Sheets(Sheets.Count))
wsImageCopies1.Name = "ImageCopies1"


    Set CopyImage1 = FoundCell.offfset(0, 464)
    
     CopyImage1.CopyPicture xlScreen, xlPicture
     
'Assign the "ImageCopies1" sheet to an object variable
Set wsImageCopies1 = ActiveWorkbook.Worksheets("ImageCopies1")


    Worksheets("ImageCopies1").Paste _
    Destination:=Worksheets("ImageCopies1").Range("B2")
    With Selection.ShapeRange
    .LockAspectRatio = msoFalse
   ' .Left = 10
    '.Top = 10
   .Width = 160
    .Height = 128
End With
MultiPage1.Pages.Add
Dim lblCaption1 As MSForms.Label
            On Error GoTo Err_Clr
            Set lblCaption1 = MultiPage1.Pages(7).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, 484).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(7).Controls.Add("Forms.Image.1")
With oImage
    .Name = "image1"
    .Left = l
    .Top = t
    .Width = s
    .Height = s
    Sheets("ImageCopies1").Activate
      ThisWorkBook.Worksheets("ImageCopies1").ChartObjects(1).Chart.CopyPicture xlScreen, xlPicture, xlScreen
      


    Set MultiPage1.Pages(7).image1.Picture = PastePicture
    .PictureSizeMode = fmPictureSizeModeStretch
    End With
Else: Exit Sub
            End If
        End If
    End If
Err_Clr:
If Err <> 0 Then
Err.Clear
Resume Next
     End If


    End With
    End If


End Sub


Public Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function
 
Upvote 0
Tried with different options still it retrieves the image 2 cells above from the specified row (FoundCell). Tried different options and no success.
Please help
code
Code: 
Private Sub btnSearch_Click()Call ClearClipboard
            Me.btnSearch.Visible = True
            Me.CBSearchCatagory.Visible = True
            Me.CBSearchResult.Visible = True
            Me.cmdUpdate.Visible = True
            Me.cmdAdd.Visible = True
Dim FoundCell As Range
Dim MoveToTwoRowsDown As Range


    If Me.CBSearchResult.Value = "" Then
        Me.tbCVCNo.Enabled = True
    With Me.CBSearchResult
        End With
            If Me.CBSearchCatagory.Value = "Search by CVC Number" Or _
                Me.CBSearchCatagory.Value = "Search by Nasico UID Number" Or _
                Me.CBSearchCatagory.Value = "Search by Tag Number" Or _
                Me.CBSearchCatagory.Value = "Search by Customer" Or _
                Me.CBSearchCatagory.Value = "Search by Valve Manufacturer" Or _
                Me.CBSearchCatagory.Value = "Search by Job Number" And _
                Me.CBSearchResult = "" Then Exit Sub
                Me.CBSearchResult.Visible = True
            End If
                If Me.CBSearchResult.ListIndex = 0 Then
                        Beep
                            Exit Sub
                End If
            If Me.CBSearchCatagory.Value = "Search by CVC Number" And Me.tbCVCNo.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
     '   Set MoveToTwoRowsDown = FoundCell.Offset(2, 0)
            Beep
Me.tbUIDNO.Value = FoundCell.Offset(0, 1).Value
Me.tbTAGNO.Value = FoundCell.Offset(0, 2).Value
'.....
'......
'.........
Me.TextBox333.Value = FoundCell.Offset(0, 455)
Me.ComboBox21.Value = FoundCell.Offset(0, 456)
Me.VSDJOBNO.Value = FoundCell.Offset(0, 457)


If FoundCell.Offset(0, 458).Value = "Dammam" Then Me.CBLOCATION.Value = "D"
If FoundCell.Offset(0, 458).Value = "Jubail" Then Me.CBLOCATION.Value = "J"


Me.timestamp.Caption = FoundCell.Offset(0, 459) = Format(timestamp.Caption, "mmmm dd yyyy hh:mm")
Me.TextBox295.Value = FoundCell.Offset(0, 460)
Me.TextBox302.Value = FoundCell.Offset(0, 461)


If FoundCell.Offset(0, 462).Value = "AFO" Then Me.OptionButton70.Value = True
If FoundCell.Offset(0, 462).Value = "AFC" Then Me.OptionButton71.Value = True
If FoundCell.Offset(0, 463).Value = "AFO" Then Me.OptionButton72.Value = True
If FoundCell.Offset(0, 463).Value = "AFC" Then Me.OptionButton73.Value = True
  
  
  Call ClearClipboard
           'Picture1-Comment Copy to userform
'Picture1-Label Copy to userform
Dim wsImageCopies1, wsinit1 As Worksheet
Dim oImage As image
Dim oShape, CopyImage1, PasteImage1 As shape
Dim oChart As Chart
Dim sTempFilename1, strInitDir1 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
sTempFilename1 = Environ("temp") & "\temp_" & Format(Now, "yy-mm-dd_hh-mm-ss") & ".jpg"


'Dim s, l, t, h As Long
s = 260
t = 100
l = 24
h = 24
If FoundCell.Offset(0, 484).Text > 0 Then
Set wsinit1 = ActiveSheet
strInitDir1 = CurDir   'Optional: Save directory so can return to it.


MultiPage1.Pages.Add
Dim lblCaption1 As MSForms.Label
            On Error GoTo Err_Clr
            Set lblCaption1 = MultiPage1.Pages(7).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, 484).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(7).Controls.Add("Forms.Image.1")
With oImage
    .Name = "image1"
    .Left = l
    .Top = t
    .Width = s
    .Height = s
    'Sheets("ImageCopies1").Activate
    '  ThisWorkBook.Worksheets("ImageCopies1").ChartObjects(1).Chart.CopyPicture xlScreen, xlPicture, xlScreen
      
   ' Dim sel As Range
    'Set sel = .Offset(FoundCell(2, 0))
   
'Range("C5").Offset(1, 2)


'Range(MoveToTwoRowsDown).Select
'Set MoveToTwoRowsDown = Selection.Offset(0, 464).Resize(Selection.Rows.Count + 2, _
   Selection.Columns.Count).Select
   
   
'Selection(MoveToTwoRowsDown) = FoundCell.Offset(0, "QW").Resize(Rows.Count + 2, Columns.Count + 0).Select
       
       
      'Set CopyImage1 = Worksheets("Data").Cells(FoundCell.Offset(2, 464).Resize(Rows.Count + 2, Columns.Count), 464)
      
      ' Set CopyImage1 = Worksheets("Data").Cells(FoundCell.Offset(0, "QW").Resize(FoundCell.Offset(FoundCell.Rows.Count + 2, FoundCell.Columns.Count).Select), "QW")
      
       'ActiveCell.Offset(0, 464).Select
       
       
        'Sheets("Data").Activate






'Below code works but copies 2 cells above the foumdcell row
'because I am having 2 rows of table headings
'Any advice,,,,xxxxxxxxxxxxxxx


'xxxxxxxxxxxxxxxxxxxx


'xxxxxxxxxxxxxxx


Set CopyImage1 = Worksheets("Data").Cells(FoundCell.Offset, "QW")


     CopyImage1.CopyPicture xlScreen, xlPicture


    Set MultiPage1.Pages(7).image1.Picture = PastePicture
    .PictureSizeMode = fmPictureSizeModeStretch
    
    End With
Else: Exit Sub
Call ClearClipboard
            End If
        End If
    'End If
Err_Clr:
If Err <> 0 Then
Err.Clear
Resume Next
     End If


    End With
    End If


End Sub
'------
Public Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function
 
Upvote 0
SOLVED Re: Reference to variable Cell Image to Other sheet

YOU ARE GENIUS!!!
Problem Solved
Thanks..
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
I have 1 UserForm and want to save to different sheets in the same workbook
2
Replies
10
Views
177
Ellendigitl00
E
P
  • Solved
Loading sheet row data to a userform issue.
Replies
7
Views
232
DanteAmor
DanteAmor
N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
251
mumps
mumps
T
  • Solved
Range inside cell reference
Replies
4
Views
368
smozgur
smozgur
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
160
krunal123
K

Forum statistics

Threads
1,223,264
Messages
6,171,081
Members
452,377
Latest member
bradfordsam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top