Hi Excelbench,
I created a little File that maybe is an Alternative for your.
I Assumed that everyone has access to the Excelfolder and that you only use images for the news
So i added a folder Pictures where you can put all the Pictures that you wanna show and name them like you would name the Entry on your "Database"
Then when the User opens the File he gets the Userform and it loads all the Image Names into a Listbox
When the user Clicks an Entry the Script opens another (empty) userform and sets the Background image to the Selected File
I also added a self resize in the userform with a max size of 800x600 (can be adjusted)
Important is that the Pictures can only be in BMP GIF or JPG Format
Check it out and let me know if it works for you.
Just download the Zip File and unpack the folder and Excel in the same location.
I already added some test pictures that i got from your file.
I think it saves you a lot of work
for everybody that just wants to look at the Code:
This all goes in the Userform "Main_Form"
you also need a blank userform called "ShowImg"
Private Sub DD_Choice_Click()
ShowImg.Picture = LoadPicture(Me.DD_Choice.Value) ' Set Background Image of ShowIMG userform to selected Image
ShowImg.Caption = Me.DD_Choice.List(Me.DD_Choice.ListIndex, 0) ' Set title equal to entry in listbox
'get Picture Height and Width in Pixels
PicHeight = Round(ShowImg.Picture.Height / 26.458)
PicWidth = Round(ShowImg.Picture.Width / 26.458)
'if width or Height is not with bounds (800x600) for example set size to max of 800x600
' if width or Height is smaller than 800x600 use that resolution
If PicWidth > 800 Then
ShowImg.Width = 800
Else
ShowImg.Width = PicWidth
End If
If PicHeight > 600 Then
ShowImg.Height = 600
Else
ShowImg.Height = PicHeight
End If
'open the Showimg Form
ShowImg.Show
End Sub
Private Sub Image1_Click()
Dim mypath As String
mypath = ThisWorkbook.Path & "\Pictures\"
Call refreshlist(mypath)
End Sub
Private Sub UserForm_Initialize()
Dim mypath As String
'Show Always Centered to application
Me.Left = (Application.Width - Me.Width) / 2
Me.Top = (Application.Height - Me.Height) / 2
mypath = ThisWorkbook.Path & "\Pictures\"
Call refreshlist(mypath)
End Sub
Function refreshlist(mylocation As String)
Me.DD_Choice.Clear 'Clear the Result Box
If mylocation = "" Then ' Exit if there is no path
Exit Function
End If
file = Dir(mylocation & "*" & Me.tb_search & "*") ' get list of files and include what is in the search field
Do Until file = "" ' Loop through the Files
If InStr(1, file, ".gif") > 0 Or InStr(1, file, ".bmp") > 0 Or InStr(1, file, ".jpg") > 0 Then 'make sure filestypes can be handled by loadpicture
Me.DD_Choice.AddItem Left(file, InStr(file, ".") - 1) 'cut off the extension and add the name to column 1 in the listbox
Me.DD_Choice.List(Me.DD_Choice.ListCount - 1, 1) = mylocation & file 'write the Full path to the second column which is not shown to the user and set to bound Column
End If
file = Dir() ' next file
Loop
End Function
LinkBack URL
About LinkBacks
Register To Reply
Originally Posted by shg
Bookmarks