I haven’t fed my WebBrowser control fetish for awhile, so here it goes: Create a slide show of photos on an Excel userform.
Add a WebBrowser control to a userform and a commandbutton to start things off.
Dim pthPictures As String
Dim fleCurrPic As String
pthPictures = “C:Documents and SettingsAll Users” & _
“DocumentsMy PicturesSample Pictures”
fleCurrPic = Dir(pthPictures & “*.jpg”)
Do While Len(fleCurrPic) > 0
Me.WebBrowser1.Navigate pthPictures & fleCurrPic
Do
DoEvents
Loop Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
Application.Wait Now + TimeValue(“00:00:02”)
fleCurrPic = Dir
Loop
MsgBox “Done”
End Sub
I can’t figure out how to resize the pictures. In Internet Explorer, the picture automatically resizes when I resize the application window, but not so with the control. It could be that I need the PutProperty method, but I would think the control would inherit the properties of the automated application (assuming that’s what’s going on here). Thoughts?
Update
We all know that posting code in the comments stinks. But posting code that contains strings that look like html tags is damn near worthless. Ivan Moala sent this code via email, so I’m including it here instead of in a comment. By the way, it works great. Thanks, Ivan.
Const strPath As String = “C:Documents and SettingsAll UsersDocumentsMy
PicturesSample Pictures”
Dim m_Width As Long
Dim m_Height As Long
Private Sub CommandButton1_Click()
Dim pthPictures As String
Dim fleCurrPic As String
pthPictures = strPath
fleCurrPic = Dir(pthPictures & “*.jpg”)
Do While Len(fleCurrPic) > 0
fnCreateHTML strPath & fleCurrPic
Me.WebBrowser1.Navigate strPath & “Tmp.html”
Do
DoEvents
Loop Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
Application.Wait Now + TimeValue(“00:00:02”)
fleCurrPic = Dir
Loop
MsgBox “Done”
‘// code to delete html if required
‘Kill strPath & “Tmp.html”
End Sub
Private Function fnCreateHTML(strImgFilePath As String)
‘//————————————————————————-
————–
‘// Project : VBAProjectTest
‘// DateTime : 16/07/2005 08:35
‘// Author : “Ivan F Moala”
‘// Site : “http://www.xcelfiles.com”
‘// Purpose : Creates HTML coding to refrence an image file
‘// : Image file viewed on Webbrowser control is sized
‘// : to fit the web control screen
‘// In : string full path to image file
‘// Out/Return: None
‘// Testing : WinXP / XL2000
‘—————————————————————————
————
‘
Dim hdl As Long
Dim strAp As String
strAp = Chr(34)
m_Width = WebBrowser1.Width * 96 / 72
m_Height = WebBrowser1.Height * 96 / 72
hdl = FreeFile
Open strPath & “Tmp.html” For Output As #hdl
Print #hdl, “<html>”
Print #hdl, “<center>”
Print #hdl, “<body “
Print #hdl, “Scroll = ““NO”“”
Print #hdl, “LEFTMARGIN=0”
Print #hdl, “TOPMARGIN=0”
Print #hdl, “</BODY>”
Print #hdl, “<img width= “ & m_Width & _
” height= “ & m_Height & _
” SRC = “ & strAp & strImgFilePath & strAp & _
“; Border = 0/>”
Print #hdl, “</body></center>”
Print #hdl, “</html>”
Close hdl
End Function
While feeding a fetish is good, you can easily get a little more control over the scaling if you do the same thing with an image control
Replace the WebBrowser control with an image control (Image1) and change your code to
Private Sub CommandButton1_Click()
Dim pthPictures As String
Dim fleCurrPic As String
pthPictures = “C:Documents and SettingsAll Users” & _
“DocumentsMy PicturesSample Pictures”
fleCurrPic = Dir(pthPictures & “*.jpg”)
Do While Len(fleCurrPic) > 0
‘ Me.WebBrowser1.Navigate pthPictures & fleCurrPic
Image1.Picture = LoadPicture(pthPictures & fleCurrPic)
Image1.PictureSizeMode = fmPictureSizeModeZoom
‘ Do
DoEvents
‘ Loop Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
Application.Wait Now + TimeValue(“00:00:02?)
fleCurrPic = Dir
Loop
MsgBox “Done”
End Sub
Dick
Here is how I would do this.
I’m sure there are other ways …. but
you basically need to load up a html coded page that references the image.
I have examples of doing this here;
http://www.xcelfiles.com/WebBrowserCtrl.html
Any way this is how I did it
Option Explicit
Const strPath As String = “C:Documents and SettingsAll UsersDocumentsMy PicturesSample Pictures”
Dim m_Width As Long
Dim m_Height As Long
Private Sub CommandButton1_Click()
Dim pthPictures As String
Dim fleCurrPic As String
pthPictures = strPath
fleCurrPic = Dir(pthPictures & “*.jpg”)
Do While Len(fleCurrPic) > 0
fnCreateHTML strPath & fleCurrPic
Me.WebBrowser1.Navigate strPath & “Tmp.html”
Do
DoEvents
Loop Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
Application.Wait Now + TimeValue(“00:00:02?)
fleCurrPic = Dir
Loop
MsgBox “Done”
‘// code to delete html if required
‘Kill strPath & “Tmp.html”
End Sub
Private Function fnCreateHTML(strImgFilePath As String)
‘//———————————————————-
‘// Project : VBAProjectTest
‘// DateTime : 16/07/2005 08:35
‘// Author : “Ivan F Moala”
‘// Site : “http://www.xcelfiles.com”
‘// Purpose : Creates HTML coding to refrence an image file
‘// : Image file viewed on Webbrowser control is sized
‘// : to fit the web control screen
‘// In : string full path to image file
‘// Out/Return: None
‘// Testing : WinXP / XL2000
‘———————————————————-
‘
Dim hdl As Long
Dim strAp As String
strAp = Chr(34)
m_Width = WebBrowser1.Width * 96 / 72
m_Height = WebBrowser1.Height * 96 / 72
hdl = FreeFile
Open strPath & “Tmp.html” For Output As #hdl
Print #hdl, “”
Print #hdl, “”
Print #hdl, “”
Print #hdl, “”
Print #hdl, “”
Print #hdl, “”
Close hdl
End Function
How do you make a slideshow of picture and then putting on a macro? Are can you do that?