VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As LongPtr, ByVal lpClassname As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As LongPtr
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal Hwnd As LongPtr, ByVal wCmd As LongPtr) As LongPtr
Private Declare PtrSafe Function apiGetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal Hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As LongPtr, ByVal lpString As String, ByVal aint As LongPtr) As LongPtr

Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
 
Public Sub getAppList()

Dim xStr As String, xHandleStr As String, ComputerName, UserName As String, UnlockSheet As String
Dim xStrLen As LongPtr, xHandle As LongPtr, xHandleLen As LongPtr, xHandleStyle As LongPtr
Dim ArrInput() As String
Dim x As Integer, i As Integer, lastrow As Integer
Dim ArrOutput As Variant

If Not WorksheetExists("listApp") Then
    On Error Resume Next
    Worksheets.Add.Name = "listApp"
    On Error GoTo 0
End If

UnlockSheet = GetPassword(UnlockSheet)
Debug.Print UnlockSheet

ComputerName = VBA.Environ("computername")
Debug.Print ComputerName

UserName = VBA.Environ("username")
Debug.Print UserName

Application.ScreenUpdating = False

With Application.ThisWorkbook.Worksheets("listApp")
    .Visible = xlSheetVisible
    .Unprotect UnlockSheet
    .Select
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    If .Range("A1") = "" Then
        .Range("A1") = ComputerName
        .Range("B1") = UserName
        .Range("C1") = VBA.FormatDateTime(VBA.Now)
        .Range("A1:C1").Interior.Color = VBA.RGB(221, 235, 247)
        With .Range("A2")
            .Value = "file/process name"
            .Interior.Color = VBA.RGB(128, 128, 128)
            .Font.Name = "Arial"
            .Font.ThemeFont = xlThemeFontMajor
            .Font.Size = "14"
            .Font.Color = VBA.RGB(255, 242, 204)
        End With
        With .Range("B2")
            .Value = "app name"
            .Interior.Color = VBA.RGB(128, 128, 128)
            .Font.Name = "Arial"
            .Font.ThemeFont = xlThemeFontMajor
            .Font.Size = "14"
            .Font.Color = VBA.RGB(255, 242, 204)
        End With
        .Range("A3").Activate
    Else
        .Range("A" & lastrow + 2) = ComputerName
        .Range("B" & lastrow + 2) = UserName
        .Range("C" & lastrow + 2) = VBA.FormatDateTime(VBA.Now)
        .Range("A" & lastrow + 2 & ":" & "C" & lastrow + 2).Interior.Color = VBA.RGB(221, 235, 247)
        With .Range("A" & lastrow + 3)
            .Value = "file/process name"
            .Interior.Color = VBA.RGB(128, 128, 128)
            .Font.Name = "Arial"
            .Font.ThemeFont = xlThemeFontMajor
            .Font.Size = "14"
            .Font.Color = VBA.RGB(255, 242, 204)
        End With
        With .Range("B" & lastrow + 3)
            .Value = "app name"
            .Interior.Color = VBA.RGB(128, 128, 128)
            .Font.Name = "Arial"
            .Font.ThemeFont = xlThemeFontMajor
            .Font.Size = "14"
            .Font.Color = VBA.RGB(255, 242, 204)
        End With
        .Range("A" & lastrow + 4).Activate
    End If
End With

i = 0

On Error Resume Next
ReDim ArrInput(0)
On Error GoTo 0

xHandle = apiGetWindow(apiGetDesktopWindow(), mcGWCHILD)

Do While xHandle <> 0
    xStr = VBA.String$(mconMAXLEN - 1, 0)
    xStrLen = apiGetWindowText(xHandle, xStr, mconMAXLEN)
    If xStrLen > 0 Then
        xStr = VBA.Left$(xStr, xStrLen)
        xHandleStyle = apiGetWindowLongPtr(xHandle, mcGWLSTYLE)
        If xHandleStyle And mcWSVISIBLE Then
            ArrInput(i) = xStr
            i = i + 1
            ReDim Preserve ArrInput(i)
        End If
    End If
    xHandle = apiGetWindow(xHandle, mcGWHWNDNEXT)
Loop

If i > 0 Then
    For x = LBound(ArrInput) To UBound(ArrInput)
        ArrOutput = Split((ArrInput(x)), "-")
        On Error Resume Next
        ActiveCell.Value = ArrOutput(0)
        ActiveCell.Offset(0, 1) = VBA.Right(ArrInput(x), VBA.Len(ArrInput(x)) - getLastOcurrence(ArrInput(x), "-") + 1)
        On Error GoTo 0
        ActiveCell.Offset(1, 0).Activate
    Next x
End If

With ActiveSheet
    .Columns.AutoFit
    .Rows.WrapText = False
    .Visible = xlSheetVeryHidden
    .Protect UnlockSheet
End With

Application.ThisWorkbook.Worksheets("Folha1").Activate ' changez le nom de la feuille, pour le nom que vous voulez toujours avoir comme visible
Application.ScreenUpdating = True

End Sub

Function getLastOcurrence(xStr As String, xChar As String)

Dim xLen As Integer, i As LongPtr
xLen = VBA.Len(xStr)

For i = xLen To 1 Step -1
    If VBA.Mid(xStr, i - 1, 1) = xChar Then
        getLastOcurrence = i
        Exit Function
    End If
Next i

End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

On Error Resume Next
WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Public Function GetPassword(XPassword As String)

GetPassword = "1234" 'changez le mot de passe ici

End Function

Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

Public Sub checkFocus()
    If GetActiveWindow <> 0 Then
        ' Excel application; Thisworkbook; ActiveSheet with focus
        'Application.ThisWorkbook.Worksheets("Feuille2").Range("A1").Value = "Excel IS active - " & VBA.FormatDateTime(VBA.Now)
    Else
        ' Excel application; Thisworkbook; ActiveSheet without focus
'        Application.ThisWorkbook.Worksheets("Feuille2").Range("B1").Value = "Excel NOT active - " & VBA.FormatDateTime(VBA.Now)
        Call getAppList
    End If
End Sub

Public Sub RunTimerCheck()
    Application.OnTime Procedure:="checkFocus", EarliestTime:=Now + TimeValue("00:00:05")
End Sub