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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.