Consulting

Results 1 to 3 of 3

Thread: picture in userform

  1. #1

    picture in userform

    Hiiiii....
    hiiii forum..members
    Please how can we display in USF1 with spinbutton also detail the image of each named after the sheet (DATABASE)
    thank you in advance
    cordially
    GAVIOTA
    picture in userform.xlsm
    Last edited by GAVIOTA ONE; 06-07-2015 at 12:12 PM.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    1. This uses PastePicture(xlPicture) from STEPHEN BULLEN, Office Automation Ltd

    2. I also changed 4 of your text boxes to labels, since it appeared they were not intended to be updated

    3. The only tricky thing to locate the image is that the top left corner of the image HAS to be in the proper row and in column 5. Other ways to do it, but it seems you wanted the image on the worksheet

    Option Explicit
    Dim aImages() As String
    Dim rData As Range
    Dim iDisplay As Long
    Private Sub SpinButton1_SpinUp()
        iDisplay = iDisplay + 1
        If iDisplay > Me.SpinButton1.Max Then iDisplay = Me.SpinButton1.Min
        pvtRefresh
    End Sub
    Private Sub SpinButton1_SpinDown()
        iDisplay = iDisplay - 1
        If iDisplay < Me.SpinButton1.Min Then iDisplay = Me.SpinButton1.Max
        pvtRefresh
    End Sub
    Private Sub UserForm_Initialize()
        Dim i As Long
        Dim oShape As Shape
        
        Set rData = Worksheets("DATABASE").Cells(1, 1).CurrentRegion
        Me.SpinButton1.Min = 2
        Me.SpinButton1.Max = rData.Rows.Count
        ReDim aImages(Me.SpinButton1.Min To Me.SpinButton1.Max)
        
        For Each oShape In Worksheets("DATABASE").Shapes
            For i = 2 To rData.Rows.Count
                If oShape.TopLeftCell.Row = i And oShape.TopLeftCell.Column = 5 Then
                    aImages(i) = oShape.Name
                    Exit For
                End If
            Next i
        Next
        iDisplay = 2
        Me.SpinButton1.Value = iDisplay
        pvtRefresh
    End Sub
    
    Private Sub pvtRefresh()
        With Me
            .TextBox5.Text = rData.Cells(iDisplay, 1).Value
            .TextBox6.Text = rData.Cells(iDisplay, 2).Value
            .TextBox7.Text = rData.Cells(iDisplay, 3).Value
            .TextBox8.Text = rData.Cells(iDisplay, 4).Value
            
            If Len(aImages(iDisplay)) > 0 Then
                Worksheets("DATABASE").Shapes(aImages(iDisplay)).Copy
                Set Image1.Picture = PastePicture(xlPicture)
            End If
        
        End With
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Quote Originally Posted by Paul_Hossler View Post
    1. This uses PastePicture(xlPicture) from STEPHEN BULLEN, Office Automation Ltd

    2. I also changed 4 of your text boxes to labels, since it appeared they were not intended to be updated

    3. The only tricky thing to locate the image is that the top left corner of the image HAS to be in the proper row and in column 5. Other ways to do it, but it seems you wanted the image on the worksheet

    Option Explicit
    Dim aImages() As String
    Dim rData As Range
    Dim iDisplay As Long
    Private Sub SpinButton1_SpinUp()
        iDisplay = iDisplay + 1
        If iDisplay > Me.SpinButton1.Max Then iDisplay = Me.SpinButton1.Min
        pvtRefresh
    End Sub
    Private Sub SpinButton1_SpinDown()
        iDisplay = iDisplay - 1
        If iDisplay < Me.SpinButton1.Min Then iDisplay = Me.SpinButton1.Max
        pvtRefresh
    End Sub
    Private Sub UserForm_Initialize()
        Dim i As Long
        Dim oShape As Shape
        
        Set rData = Worksheets("DATABASE").Cells(1, 1).CurrentRegion
        Me.SpinButton1.Min = 2
        Me.SpinButton1.Max = rData.Rows.Count
        ReDim aImages(Me.SpinButton1.Min To Me.SpinButton1.Max)
        
        For Each oShape In Worksheets("DATABASE").Shapes
            For i = 2 To rData.Rows.Count
                If oShape.TopLeftCell.Row = i And oShape.TopLeftCell.Column = 5 Then
                    aImages(i) = oShape.Name
                    Exit For
                End If
            Next i
        Next
        iDisplay = 2
        Me.SpinButton1.Value = iDisplay
        pvtRefresh
    End Sub
    
    Private Sub pvtRefresh()
        With Me
            .TextBox5.Text = rData.Cells(iDisplay, 1).Value
            .TextBox6.Text = rData.Cells(iDisplay, 2).Value
            .TextBox7.Text = rData.Cells(iDisplay, 3).Value
            .TextBox8.Text = rData.Cells(iDisplay, 4).Value
            
            If Len(aImages(iDisplay)) > 0 Then
                Worksheets("DATABASE").Shapes(aImages(iDisplay)).Copy
                Set Image1.Picture = PastePicture(xlPicture)
            End If
        
        End With
    
    End Sub

    hiii Paul_Hossler
    thank you master
    is flawless
    I will wish
    thank you a lot
    it is resolved
    cordially
    GAVIOTA

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •