Results 1 to 8 of 8

Thread: VBA function running continuously in PowerPoint?

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    VBA function running continuously in PowerPoint?

    Hello VBA experts

    Im work on a ship in the north atlantic ocean, where we like all others are using satellite communication.
    Its part of my job to keep it running, but unstable connection makes pople call my all the time. So on the televisions we have a PowerPoint running in loob with information.
    I have a VBA that are displaying a figure off the internet status. Its change coloer if we loose the internet.

    I can get it to run automatically when I open the PowerPoint by using a shortcut and add the text
    "C:\Program Files (x86)\Microsoft Office\Office16\POWERPNT.EXE" /M "C:\InfoTV\Powerpoint figur internet status\Powerpoint status.pptm" "changedcolor

    Hers the problem, its only run one time, how to make it to run continuously?

    You can see my code and I have Attach my powerpoint.

    In advanced thanks.

    Sub changedcolor()
        Dim hshp As Shape
        Dim osld As Slide
        For Each osld In ActivePresentation.Slides
            For Each hshp In osld.Shapes
                With hshp
                    If .Name Like "GoogleShape*" And IsConnected = True Then
                        .Fill.ForeColor.RGB = RGB(255, 255, 255)
                    ElseIf .Name Like "GoogleShape*" And IsConnected = False Then
                        .Fill.ForeColor.RGB = RGB(50, 50, 50)
                    End If
                End With
            Next hshp
        Next osld
    End Sub
    Public Function IsConnected()
        Dim objFS As Object
        Dim objShell As Object
        Dim objTempFile As Object
        Dim strLine As String
        Dim strFileName As String
        Dim strHostAddress As String
        Dim strTempFolder As String
        strTempFolder = "C:\PingTemp"
        strHostAddress = ""
        IsConnected = True ' Assume success
        Set objFS = CreateObject("Scripting.FileSystemObject")
        Set objShell = CreateObject("Wscript.Shell")
        If Dir(strTempFolder, vbDirectory) = "" Then
            MkDir strTempFolder
        End If
        strFileName = strTempFolder & "" & objFS.GetTempName
        If Dir(strFileName) <> "" Then
            objFS.DeleteFile (strFileName)
        End If
        objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
        Set objTempFile = objFS.OpenTextFile(strFileName, 1)
        Do While objTempFile.AtEndOfStream <> True
            strLine = objTempFile.Readline
            If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
                IsConnected = False
            End If
        objFS.DeleteFile (strFileName)
        objFS.DeleteFolder (strTempFolder)
    End Function
    Attached Files Attached Files
    Last edited by georgiboy; 04-08-2024 at 05:30 AM. Reason: Edited code tags

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts