Help optimize: Random Background Image every 3sec from folder

[Soraka]

Hello,
So I have this code, written by someone else, that is working but makes my spreadsheet freeze everytime it loads the new image (3sec if I let it as is in the code). I can't scroll up/down at that specific moment, but once the new background image is loaded it is fine.
I would like to optimize and remove the freezes from Excel if possible or diminish it a lot in the worst case.

I do not understand the code itself, it is way out of my understanding.

Thank you

ThisWorkbook

Private Sub Workbook_Open()
...
mainbg = True
Pause = False
    Call file_names
    Call Macro1
...
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Macro2
...
End Sub

Module11

Public mainbg As Boolean

Option Explicit

Const pth = "C:\Personnel\Backgrounds\"
Const mfPttrn = "*.jpg"

Private i As Integer, rn As Integer
Private TimeToRun As Date
Private fleTbl() As String

Sub file_names()
    mainbg = True
    Dim fle As String
    i = CreateObject("Scripting.FileSystemObject").GetFolder(pth).Files.Count
    ReDim fleTbl(1 To i, 1 To 2)
    i = 0
    fle = Dir(pth & mfPttrn, vbNormal)
    Do Until fle = ""
    If mainbg = False Then GoTo LabelEnd
        i = i + 1
        fleTbl(i, 1) = i
        fleTbl(i, 2) = pth & fle
        fle = Dir()
    Loop
LabelEnd:
End Sub

Sub Macro1()
    If mainbg = False Then GoTo LabelEnd
    Randomize
    rn = Int(UBound(fleTbl, 1) * Rnd + 1)
    ActiveSheet.SetBackgroundPicture Filename:=fleTbl(rn, 2)
    TimeToRun = Now + TimeValue("00:00:03")
    Application.OnTime EarliestTime:=TimeToRun, Procedure:="Macro1"
LabelEnd:
End Sub

Public Function FilenameFromPath(path As String) As String

   Dim S As String
   Dim V As Variant
  
   ' Make sure all separators are the same
   path = Replace(path, "/", "\")
  
   V = Split(path, "\")
   FilenameFromPath = V(UBound(V))
  
End Function

Sub Macro2()
    On Error Resume Next
    Application.OnTime EarliestTime:=TimeToRun, Procedure:="Macro1", Schedule:=False
    ActiveSheet.SetBackgroundPicture Filename:=""
    fleTbl = Empty
End Sub

 

[bobsan42]

I personally do not think there is a way to avoid this by optimising any code.
Eventually Excel will have to load the image, so this will take time.
The best approach IMO is to compress the pictures / reduce drastically the file size of the images.
Even softwares dedicated to image viewing take time to load images.
The only way in theory would be to use a separate thread to buffer the image into memory and then just use it almost instantly. If this can be done - it is probably a serious challenge and not achievable with VBA alone.