ExcelBanter - Running a gif in an html window

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Running a gif in an html window (https://www.excelbanter.com/excel-programming/399799-running-gif-html-window.html)

Running a gif in an html window

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.

Running a gif in an html window

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
<TITLEWatch 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

"Lynn" wrote in message
...
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.

Running a gif in an html window

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

"Lynn" wrote in message
...
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.

Running a gif in an html window

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

"Steve Yandl" wrote in message
...
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

"Lynn" wrote in message
...
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.

Running a gif in an html window

Thanks, Steve. I am going try this out. I so appreciate your help.

Lynn

"Steve Yandl" wrote:

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

"Lynn" wrote in message
...
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.