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