Solved

URGENT: HTML slideshow in VBA

Posted on 2002-05-27
14
284 Views
Last Modified: 2010-08-05
I have a directory of HTML files, which I want to show as a slideshow, written in VBA for Excel. The HTML files were created as Excel workbooks, saved as HTML format.

The structure is as follows:

workbook1 is saved as: name1.html
this then creates an html file for each worksheet in the original workbook... i.e:

worksheets 1 and 2 are saved as:

name1/sheet001.html
name2/sheet002.html ......

Q. how do I create a slide show, looping thru every sheet00x.html, with a 30 second delay between html file displays???

Many thanks,

Dave

0
Comment
Question by:DaveNoviceVB
14 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 7037178
Hi Dave,

Better use powerpoint for slideshows the viewer is free, or would you like to use excel for a slideshow? never looked at it that way

:O)Bruintje
0
 

Author Comment

by:DaveNoviceVB
ID: 7037198
I want to use VBA for Excel - any ideas??
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 7037364
Please maintain this equally "URGENT" and open question:
URGENT: VB helpfile in Excel 2000 not working Date: 02/14/2002 02:33AM PST
http://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=20266715

Thanks,
Anthony
PS There is no need to put URGENT in all your questions. It does not expedite the answer any more than maintaining your open questions.
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7037399
Well, first of all, you need a timer.
place the following code in a module:

Option Explicit
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
 ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
 ByVal nIDEvent As Long, ByVal uElapse As Long, _
 ByVal lpTimerFunc As Long) As Long

Public TimerID As Long
Public Function TimerEnable(ByVal hWnd As Long, _
  ByVal mSecs As Long) As Long
TimerEnable = SetTimer(hWnd, TimerID, mSecs, _
 AddressOf TimerFired)
End Function

Public Function TimerDisable(ByVal hWnd As Long) As Long
TimerDisable = KillTimer(hWnd, TimerID)
End Function

Private Sub TimerFired(ByVal hWnd As Long, _
 ByVal TimerID As Long, ByVal IDEvent As Long, _
 ByVal dwTime As Long)
Debug.Print "Fired "; hWnd; TimerID; IDEvent; Time 'dwTime
End Sub
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7037455
Could you try this?
'NOTE: replace first sPath variable with your choice

Option Explicit

Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Public TimerID As Long
Dim arrFolders() As String
Dim arrFiles() As String
Sub main()
Dim ffile As String, ffolder As String
Dim sPath As String
Dim idx As Integer

sPath = "c:\"
ffolder = Dir$(sPath & "\*.*", vbDirectory)
Do While ffolder <> ""
    If (ffolder <> "." And ffolder <> "..") Then
        ReDim Preserve arrFolders(idx)
        arrFolders(idx) = sPath & "\" & ffolder
        idx = idx + 1
    End If
Loop

idx = 0
For idx = 0 To UBound(arrFolders) - 1
    sPath = arrFolders(idx)
    ffile = Dir$(sPath & "\*.htm", vbArchive)
    Do While ffile <> ""
        ReDim Preserve arrFiles(idx)
        arrFiles(idx) = sPath & "\" & ffile
    Loop
Next idx
TimerEnable 0, 30000
End Sub


Public Function TimerEnable(ByVal hWnd As Long, _
 ByVal mSecs As Long) As Long
TimerEnable = SetTimer(hWnd, TimerID, mSecs, _
AddressOf TimerFired)
End Function

Public Function TimerDisable(ByVal hWnd As Long) As Long
TimerDisable = KillTimer(hWnd, TimerID)
End Function

Private Sub TimerFired(ByVal hWnd As Long, _
ByVal TimerID As Long, ByVal IDEvent As Long, _
ByVal dwTime As Long)
    ' this error is necesary only the first time
    On Error Resume Next
    Static shItem As Long
    If shItem <= UBound(arrFiles) Then
        With Application
            .Workbooks(shItem).Saved = True
            .Workbooks(shItem).Close
            .Open arrFiles(shItem)
        End With
        shItem = shItem + 1
    Else
        TimerDisable 0
    End If
End Sub


0
 
LVL 2

Expert Comment

by:TrueDrake
ID: 7037519
Hi,

I had an interesting suggestion (using references), but I don't want to put any effort for people who want others to solve their problems just for kicks.

Enjoy
0
 

Author Comment

by:DaveNoviceVB
ID: 7041249
Richie,

thanks VERY much for your response - I'll try it and get back to you as soon as I can. The reason I didn't post any code is because I am new to VB and want to learn, but didn't know where to start.

Thanks again Richie,

Dave
0
 

Author Comment

by:DaveNoviceVB
ID: 7041255
I will not be posting URGENT again in the title.
Dave
0
 
LVL 16

Accepted Solution

by:
Richie_Simonetti earned 300 total points
ID: 7041759
"minor bugs" solved:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
TimerDisable
End Sub

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Public TimerID As Long
Dim arrFolders() As String
Dim arrFiles() As String
Dim hw As Long
Sub main()

Dim ffile As String, ffolder As String
Dim sPath As String
Dim idx As Integer

hw = FindWindow(vbNullString, "microsoft excel - " & ThisWorkbook.Name)
sPath = "C:\A_Project\ee\listhtm\"
ffolder = Dir$(sPath & "*.*", vbDirectory)
Do While ffolder <> ""
   If (ffolder <> "." And ffolder <> "..") Then
    If GetAttr(sPath & ffolder) = vbDirectory Then
       ReDim Preserve arrFolders(idx)
       arrFolders(idx) = sPath & ffolder & "\"
       idx = idx + 1
    End If
   End If
   ffolder = Dir$()
Loop

idx = 0
Dim i As Integer
For idx = 0 To UBound(arrFolders)
   ffile = Dir$(arrFolders(idx) & "*.htm", vbArchive)
   Do While ffile <> ""
       ReDim Preserve arrFiles(i)
       arrFiles(i) = arrFolders(idx) & ffile
       i = i + 1
       ffile = Dir$()
   Loop
Next idx
'Application.Workbooks.Open arrFiles(0)

TimerEnable 10000
End Sub


Public Function TimerEnable(ByVal mSecs As Long) As Long
TimerEnable = SetTimer(hw, TimerID, mSecs, _
AddressOf TimerFired)
End Function

Public Function TimerDisable() As Long
TimerDisable = KillTimer(hw, TimerID)
End Function

Private Sub TimerFired(ByVal hWnd As Long, _
ByVal TimerID As Long, ByVal IDEvent As Long, _
ByVal dwTime As Long)
On Error GoTo errTrap

Static shItem As Long

With ActiveWorkbook
    Debug.Print .Name
    If .Name <> "SlideShow_htm.xls" Then
      .Saved = True
      .Close
    End If
End With
 
If shItem <= UBound(arrFiles) Then
  Application.Workbooks.Open arrFiles(shItem)
Else
    TimerDisable
End If
shItem = shItem + 1

Exit Sub
errTrap:
If Err = 9 Then
  Resume Next
Else
  TimerDisable
  MsgBox Err.Number & " - " & Err.Description
End If
End Sub


0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7041944
To sort Arrfiles array, you could see:
http://www.vb2themax.com/HtmlDoc.asp?Table=Articles&ID=10

Just a question: Why do you need to slide those files in Excel?
With Automation you could slide them in Internet Explorer. If you change your mind, i have the code to do it with IE.
0
 

Author Comment

by:DaveNoviceVB
ID: 7042166
I've hit a stumbling block - when opening the \sheet00x.html file, it always defaults back to what was the 1st worksheet in the workook - despite clicking the sheet00x.html file. ANy ideas how to change this??

How do you automate in IE?? Maybe better fix. I wanted to do it in VBA just so I can use it to pickup alll html files in a directory and produce the slideshow automatically.

Thanks alot for your help so far. I didn't know I could offend so many people with 1 question.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7042189
You could manage Internet Explorer with VBA (from Excel,Word, etc).
"...
I've hit a stumbling block - when opening the \sheet00x.html file, it always defaults back to what was
the 1st worksheet in the workook - despite clicking the sheet00x.html file. ANy ideas how to change
this??
...."
 Sorry, i didn't understand that. How many sheets were in each workbook?
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7818624
Hi DaveNoviceVB,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept Richie_Simonetti's comment(s) as an answer.

DaveNoviceVB, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 

Expert Comment

by:SpideyMod
ID: 7910019
per recommendation

SpideyMod
Community Support Moderator @Experts Exchange
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question