Running a gif in an html window

L

Lynn

Does anyone know if it is possible to run an animated gif through an html
window via Excel VBA while the Excel macro continues to run?

Thanks.
 
S

Steve Yandl

Lynn,

You might be able to but I just tested a routine that used to work for me
and I now get an IE window with a placeholder for the animated GIF (I'm
running IE7). If you want to test it, the code is

______________________________

On Error Resume Next

Set objIE = CreateObject("InternetExplorer.Application")

With objIE
..Navigate "about:blank"
..Toolbar = 0
..StatusBar = 0
..Width = 400
..Height = 200
..Visible = 1
End With


objIE.Document.Title = "Entertainment while sub runs"
objIE.Document.Body.InnerHTML = "<img src= 'file:///c:\Test\flag.gif'> "

______________________________


There is a workaround that might suit you. For my test, I placed my
animated GIF named "Animated.gif" in "c:\Test" as well as a text file named
"myShow.hta". Note that the file extension must be HTA rather than HTM or
HTML. The contents of this HTA file are between the lines below:

_____________________________________
<HTML>
<HEAD>
<TITLE>Watch This</TITLE>
</HEAD>
<SCRIPT LANGUAGE="VBScript">
Sub Window_onLoad
window.resizeTo 400,250
End Sub
</SCRIPT>

<BODY background = "Animated.gif">
</BODY>
</HTML>
_________________________________________

To run this HTA file from within VBA, use:

Dim RetVal
RetVal = Shell("mshta.exe C:\Test\myShow.hta", 1)


Steve
 
S

Steve Yandl

Lynn,

I decided to play with this a bit and came up with something that might work
for you. The subroutine below that I named Showcase takes two arguments,
the name of the gif including the file path and an optional argument for the
number of seconds you want it to run. If you leave off the optional
argument, it runs for 15 seconds. When launched, the sub checks that the
animated gif file exists and then determines its height and width. A
temporary hta file is created that presents a window with no title bar, no
scroll bar and the exact dimensions to display the animated gif. The
temporary hta is launched for the specified time period and the file itself
is deleted from the temp folder.

To call the subroutine, you could use a different three line sub like this:
___________________________________

Sub LaunchTest()
Showcase ("C:\Test\Animated.gif", 30)
End Sub
__________________________________



Here is the actual sub

_________________________________

Sub Showcase(strFileToChk As String, Optional intDur As Integer = 15)

Const filePropName = 0
Const filePropDimensions = 26

Dim retVal
Dim w As String ' integer representing width considered as text string
Dim h As String ' integer representing height considered as text string

Set FSO = CreateObject("Scripting.FileSystemObject")

' Check the animated picture file exists and get its dimensions
If FSO.FileExists(strFileToChk) Then
Set objShell = CreateObject("Shell.Application")
strArgParent = FSO.GetParentFolderName(strFileToChk)
strArgFileName = FSO.GetFileName(strFileToChk)
Set objFolder = objShell.Namespace(strArgParent)

For Each strFileName In objFolder.Items
If objFolder.GetDetailsOf(strFileName, filePropName) =
strArgFileName Then
strDimensions = objFolder.GetDetailsOf(strFileName,
filePropDimensions)
End If
Next

If InStr(strDimensions, " x ") > 0 Then
sizeArr = Split(strDimensions, "x")
w = Trim(sizeArr(0))
h = Trim(sizeArr(1))
End If
Else
Set FSO = Nothing
Exit Sub
End If

' Create an HTA file to show the animated file from
strHTAname = FSO.GetSpecialFolder(2) & "\Temp0.hta"
Set txtHTA = FSO.CreateTextFile(strHTAname)

With txtHTA
.WriteLine "<HTML>"
.WriteLine "<HTA:Application"
.WriteLine "Caption=" & Chr(34) & "no" & Chr(34)
.WriteLine "Scroll=" & Chr(34) & "no" & Chr(34) & ">"
.WriteLine "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
.WriteLine "Sub Window_OnLoad"
.WriteLine "window.resizeTo " & w & ", " & h
.WriteLine "idTimer = window.setTimeout(" & Chr(34) & "CloseShop" &
Chr(34) _
& ", " & CStr(intDur * 1000) & ", " & Chr(34) & "VBScript" & Chr(34) &
")"
.WriteLine "End Sub"
.WriteLine "Sub CloseShop"
.WriteLine "window.clearTimeout(idTimer)"
.WriteLine "self.close()"
.WriteLine "End Sub"
.WriteLine "</SCRIPT>"
.WriteLine "<BODY background=" & Chr(34) & strFileToChk & Chr(34) & ">"
.WriteLine "</BODY>"
.WriteLine "</HTML>"
.Close
End With

' Run the new HTA file
retVal = Shell("mshta.exe " & strHTAname, vbNormalFocus)

' Delete the HTA file from the Temp folder
FSO.DeleteFile strHTAname

Set objShell = Nothing
Set FSO = Nothing
End Sub

________________________________

Steve
 
S

Steve Yandl

Note that the two lines

If objFolder.GetDetailsOf(strFileName, filePropName) =
strArgFileName Then

and

strDimensions = objFolder.GetDetailsOf(strFileName,
filePropDimensions)

should each be on a single line rather than broken up.

Steve
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Office 365 Outlook adding unwanted HTML to Email Body 0
Animated GIF's do not work properly in Powerpoint 2010 2
Running macro when communicator message is received 0
Running GIF in userform 0
Autonumber field in Excel that behaves the same as Access 0
How to render HTML inside a Powerpoint slide through VBA 0
How to Pause an Excel VBA script without freezing excel 1
Can I edit macro buttons on the quick access toolbar in excel? 0

Top