Random background image from folder with 1 error

Hello,

I made a background change on loop from a folder with pictures.
The macro starts as I open the xlsm.
The background changes every xx second and works perfectly, outside one error.

It sometimes (more frequently if less images in the folder) displays a white background, as if there was a plain white picture in the folder.
I even made the test to only keep 1 image in the folder and it shows the image then plain white, as background.

Any idea why?

ThisWorkbook:
Private Sub Workbook_Open()
Call file_names
Call Macro1
Application.WindowState = xlNormal
Application.Top = 0
Application.Left = 815
Application.Width = 627
Application.Height = 782
End Sub

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


Module1:
Option Explicit

Const pth = "D:\Backgrounds"
Const mfPttrn = "*.jpg"

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

Sub file_names()
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 = ""
i = i + 1
fleTbl(i, 1) = i
fleTbl(i, 2) = pth & fle
fle = Dir()
Loop
End Sub
Sub Macro1()
Randomize
rn = Int(UBound(fleTbl, 1) * Rnd + 1)
ActiveSheet.SetBackgroundPicture Filename:=fleTbl(rn, 2)
TimeToRun = Now + TimeValue("00:00:30")
'Change duration above hours:minutes:seconds
Application.OnTime EarliestTime:=TimeToRun, Procedure:="Macro1"

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