WebBrowser Slide Show

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.

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
        Do
            DoEvents
        Loop Until Me.WebBrowser1.ReadyState = READYSTATE_COMPLETE
        Application.Wait Now + TimeValue(“00:00:02”)
        fleCurrPic = Dir
    Loop
 
    MsgBox “Done”
 
End Sub

userform with webbrowser control showing last picture and a message box

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.

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, “<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

Posted in Uncategorized

3 thoughts on “WebBrowser Slide Show

  1. 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

  2. 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

Leave a Reply

Your email address will not be published. Required fields are marked *