[WorkBook] = WebBrowser_DC.xls [VBModule] = frmWebBrowser [Sub or Function] = Entire Module
Option Explicit



Const strPath As String = "C:\Documents and Settings\All Users\Documents\My Pictures\Sample 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, "</CENTER>"

    Print #hdl, "</HTML>"



Close hdl





End Function