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