PDA

View Full Version : [SOLVED] picture in userform



GAVIOTA ONE
06-07-2015, 10:13 AM
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
13626

Paul_Hossler
06-07-2015, 12:15 PM
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

GAVIOTA ONE
06-07-2015, 12:29 PM
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