Auto Scroll Separate Files

[jarett]

I am setting up a TV screen that is hooked up to a laptop (HDMI), I have 4-5 separate Excel files that I would like to display on the tv screen. The files are not live and will just refresh through out the day. I know I can adjust the size and have all of them open on the same screen but, I was looking for a way to have each one open at maximum screen size and basically toggle/scroll to each file every minute or so. Is this possible or do I need some third party software add on?

 

[Candyman8019]

Okay, it turns out it doesn't like the full path and filename when activating sheets...so try this:

Private Sub rotatesheets()
Dim lrow As Long
lrow = Sheet1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'open sheets listed in column A on Sheet1
For x = 1 To lrow
Workbooks.Open Sheet1.Range("A" & x).Value
ActiveWindow.WindowState = xlMaximized
Next x

'start rotating sheets
restartloop:
For x = 1 To lrow
Workbooks(Mid$(Range("A" & x).Value, InStrRev(Range("A" & x).Value, "/") + 1, Len(Range("A" & x).Value))).Activate
Application.Wait (Now + TimeValue("00:01:00"))
Next x

GoTo restartloop
End Sub

 

[Candyman8019]

One thing to note on the above, is if your file paths have a "\" rather than "/" then change that in the rotate sheets section.

 

[jarett]

One thing to note on the above, is if your file paths have a "\" rather than "/" then change that in the rotate sheets section.

Okay, it turns out it doesn't like the full path and filename when activating sheets...so try this:

Private Sub rotatesheets()
Dim lrow As Long
lrow = Sheet1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'open sheets listed in column A on Sheet1
For x = 1 To lrow
Workbooks.Open Sheet1.Range("A" & x).Value
ActiveWindow.WindowState = xlMaximized
Next x

'start rotating sheets
restartloop:
For x = 1 To lrow
Workbooks(Mid$(Range("A" & x).Value, InStrRev(Range("A" & x).Value, "/") + 1, Len(Range("A" & x).Value))).Activate
Application.Wait (Now + TimeValue("00:01:00"))
Next x

GoTo restartloop
End Sub

Made the change and edited the code to account for "\", received a "run time error '9' Subscript out of range". It opened the files but didn't rotate and I noticed some of the charts in the files did not load all the way.

 

[jarett]

Each file needs to be refreshed when opened if that makes a difference.

 

[Candyman8019]

try something like this:

Private Sub rotatesheets()
Dim lrow As Long
lrow = Sheet1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

'open sheets listed in column A on Sheet1
For x = 1 To lrow
Workbooks.Open Sheet1.Range("A" & x).Value, UpdateLinks:=true
ActiveWindow.WindowState = xlMaximized
Next x

'start rotating sheets
restartloop:
For x = 1 To lrow
Workbooks(Mid$(Range("A" & x).Value, InStrRev(Range("A" & x).Value, "/") + 1, Len(Range("A" & x).Value))).Activate
Application.Wait (Now + TimeValue("00:01:00"))
Next x

GoTo restartloop
End Sub