Autres Problème de Progress Bar (erreur d'ocx)

DenisHen · 9 Avril 2025

Bonjour à la communauté.

Je viens de découvrir un problème sur mon Ordi Portable Perso, Il plante lors d'un Progress Bar (Win11, Office 2024) est modifiée dans l'UserForm en VBA.
Mais sur mon Ordi Fix Perso (Win11, Office 2024), ça fonctionne, et sur le PC Portable Pro (Win10, Office 365) ça fonctionne aussi.

J'ai tenté plein de manipulation trouvées un peu partout sur le net.
Retélécharger le MsComCtl.ocx, version 32 ou version 64, puis dans PowerShell (mode Admin), les regsvr32 mscomctl.ocx dans system32 ou syswow64...

Aucun changement, quelqu'un aurait une idée ?

Denis.

cathodique · 22 Décembre 2025

Bonjour,

Voir cette discussion
J'avais eu ce problème avec Listview sur Excel 2010 32 bits - Win7 64 bits.
Je ne pourrais t'en dire plus.
Bonne journée.

patricktoulon · 22 Décembre 2025

bonsoir
d'apres ce que j'ai vu l'astuce corrige le listview mais le progressbar c'est mort pour 64
c'est moins beau mais tu pourais utiliser un scrollbar le curseur avancerait en fonction de:

cathodique · 23 Décembre 2025

patricktoulon à dit:
bonsoir
d'apres ce que j'ai vu l'astuce corrige le listview mais le progressbar c'est mort pour 64
c'est moins beau mais tu pourais utiliser un scrollbar le curseur avancerait en fonction de:

Bonjour,

progressbar pas mort pour moi.

patricktoulon · 23 Décembre 2025

Bonjour cathodique
ben tu es sur 32 bits excel 2010 donc bien sur que ca fonctionne
les versions d'excel32 fonctionnent en 32 même sur des windows 64 qu’elle, ce soit la version vista ,7 ,10,11

cathodique · 25 Décembre 2025

Bonjour Patrick,

patricktoulon à dit:
d'apres ce que j'ai vu l'astuce corrige le listview mais le progressbar c'est mort pour 64

Je n'ai donc pas compris ce que tu voulais dire.
Si c'est Excel 64 bits, je ne peux rien dire, je ne l'ai pas sur ma machine.
J'avais la possibilité de l'installer mais j'ai suivi les conseils de Microsoft d'installer la 32 bits au lieu de la 64 bits.
Et ce, même sur un système 64 bits (qui est mon cas).
J'avais eu un problème avec certains ActiveX (MSCOMCTL.OCX).
J'ai résolu le problème mais depuis j'évite d’utiliser les objets ActiveX.
Comme la ProgressBar, elle fonctionne sur ma bécane mais je lui préfère la progression avec un Label.
Ainsi, je n'ai plus de mauvaises surprises en utilisant mes fichiers sur une autre machine de configuration différente à la mienne.

Bonne journée.

Dranreb · 25 Décembre 2025

Bonjour et joyeux Noël.
Pour toutes mes application où j'en ai besoin j'utilise une version légèrement simplifiée de l'UFmProg présent dans ce classeur.

Rheeem · 25 Décembre 2025

Il est possible d'utiliser le progressbar natif de windows,
pour cela, placer un Frame dans une fiche est lancer le code suivant :

Code:

Option Explicit
Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, _
         ByVal lpClassName As String, ByVal lpWindowName As String, _
         ByVal dwStyle As Long, _
         ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
         ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _
         ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As Any) As Long

Private Const PBM_SETPOS = &H402
Private Const PBM_SETRANGE32 = &H406
 
Private Sub CommandButton1_Click()
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Dim rect(0 To 3) As Long, i, PrBar As LongPtr
 GetClientRect Frame1.[_GethWnd], rect(0)
 PrBar = CreateWindowExA(0, "msctls_progress32", "", WS_VISIBLE Or WS_CHILD, _
          0, 0, rect(2), rect(3), _
          Frame1.[_GethWnd], 0, 0, 0)
 SendMessageA PrBar, PBM_SETRANGE32, 1, 1000
 Dim t As Single
 t = Timer
 For i = 1 To 1000
    SendMessageA PrBar, PBM_SETPOS, i, 0
    While (Timer - t) < 0.01
     DoEvents
    Wend
    t = Timer
 Next
 MsgBox "fin"
End Sub

cathodique · 25 Décembre 2025

Rheeem à dit:

Il est possible d'utiliser le progressbar natif de windows,
pour cela, placer un Frame dans une fiche est lancer le code suivant :

Code:

Option Explicit
Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, _
         ByVal lpClassName As String, ByVal lpWindowName As String, _
         ByVal dwStyle As Long, _
         ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
         ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _
         ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As Any) As Long

Private Const PBM_SETPOS = &H402
Private Const PBM_SETRANGE32 = &H406
 
Private Sub CommandButton1_Click()
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Dim rect(0 To 3) As Long, i, PrBar As LongPtr
 GetClientRect Frame1.[_GethWnd], rect(0)
 PrBar = CreateWindowExA(0, "msctls_progress32", "", WS_VISIBLE Or WS_CHILD, _
          0, 0, rect(2), rect(3), _
          Frame1.[_GethWnd], 0, 0, 0)
 SendMessageA PrBar, PBM_SETRANGE32, 1, 1000
 Dim t As Single
 t = Timer
 For i = 1 To 1000
    SendMessageA PrBar, PBM_SETPOS, i, 0
    While (Timer - t) < 0.01
     DoEvents
    Wend
    t = Timer
 Next
 MsgBox "fin"
End Sub

Bonsoir,

Le demandeur (@DenisHen ) a eu un problème d'ocx.
Je lui ai indiqué une discussion traitant de ce problème.
Que j'avais moi-même rencontré (impactant un listview et progressbar).
Ta solution native windows semble intéressante.
Aurai-tu un classeur exemple?

Bonne soirée.

ps: @DenisHen est sûrement parti en vacances, faire la fête.

patricktoulon · 25 Décembre 2025

Bonsoir à tous
Et c'est là que l'on voit les vieux baroudeurs
Joli !! @Rheeem 👍
il y a cependant une petite chose à régler
C’est de notoriété publique qu’office 64 /API n'aime pas trop le " As Any"
pas précis (possibilité de confondre Long/longptr)
En l'occurrence ici la pirouette cacahuète avec l'array 0 to 3 en long peut capoter en 64 bits pour la raison citée au dessus(hein vieux baroudeur)
Donc pour le coup changer l'argument dans la déclaration de l'api et ajouter la tructure rect

Mettre la variable handle en global module et le slide séparé afin d'être utilisable a tout moments.

VB:

Option Explicit
'd 'apres l'exemple de @Rheeem sur ExcelDownload
'correctif  pour la structure rect explicitement rectangle
Private Type rect
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, _
                              ByVal lpWindowName As String, ByVal dwStyle As Long, _
                              ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
                              ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _
                              ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
'Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As any) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, recta As rect) As Long

Private Const PBM_SETPOS = &H402
Private Const PBM_SETRANGE32 = &H406
Private PrBar As LongPtr

'creation de la progeressbar
Private Sub UserForm_Activate()
    Const WS_CHILD = &H40000000 'permet de créer une fenêtre sans caption(les fenêtres childs n'ont pas de barre de titre)
    Const WS_VISIBLE = &H10000000 'completement visible overlay
    
    'Dim recta(0 To 3) As Long, I
    'GetClientRect Frame1.[_GethWnd], recta(0)
    'PrBar = CreateWindowExA(0, "msctls_progress32", _
                                 "", WS_VISIBLE Or WS_CHILD, _
                                 0, 0, recta(2), recta(3), _
                                 Frame1.[_GethWnd], 0, 0, 0)
    
    Dim r As rect
    GetClientRect Frame1.[_GethWnd], r
    PrBar = CreateWindowExA(0, "msctls_progress32", _
                                "", WS_VISIBLE Or WS_CHILD, _
                                r.left, 0, r.right - r.left, r.bottom - r.top, _
                                Frame1.[_GethWnd], 0, 0, 0)
    
    
    'donner la progressbar la valeur min 1 et max de 1000
    SendMessageA PrBar, PBM_SETRANGE32, 1, 1000
    
End Sub



Private Sub CommandButton1_Click()
    Dim t As Single, I&
    t = Timer
    For I = 1 To 1000
        SendMessageA PrBar, PBM_SETPOS, I, 0
        While (Timer - t) < 0.01
            DoEvents
        Wend
        t = Timer
    Next
    MsgBox "fin"
End Sub

Cela dit pour que tout le monde comprenne
Quand on fait un getclientrect handle,rectangle(0) quand le rectangle() est un array
Implicitement l'api va te donner la largeur au lieu du right et la hauteur au lieu du bottom
Très peu de gens le savent ça, c'est pour ça que je disais belle pirouette cacahuète
mais cela implique une structure non typée comme "Any" pour l'API(capricieux en 64)

Belle démonstration en tout cas je n'y aurait pas pensé a creawindowexA type progress32
Belle alternative pour les office 64 je valide
Pour cathodique et les autres

cathodique · 26 Décembre 2025

patricktoulon à dit:
Bonsoir à tous
Et c'est là que l'on voit les vieux baroudeurs
Joli !! @Rheeem 👍
il y a cependant une petite chose à régler
C’est de notoriété publique qu’office 64 /API n'aime pas trop le " As Any"
pas précis (possibilité de confondre Long/longptr)
En l'occurrence ici la pirouette cacahuète avec l'array 0 to 3 en long peut capoter en 64 bits pour la raison citée au dessus(hein vieux baroudeur)
Donc pour le coup changer l'argument dans la déclaration de l'api et ajouter la tructure rect

Mettre la variable handle en global module et le slide séparé afin d'être utilisable a tout moments.

VB:

Option Explicit 'd 'apres l'exemple de @Rheeem sur ExcelDownload 'correctif pour la structure rect explicitement rectangle Private Type rect left As Long top As Long right As Long bottom As Long End Type Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, _ ByVal lpWindowName As String, ByVal dwStyle As Long, _ ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _ ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr 'Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As any) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, recta As rect) As Long Private Const PBM_SETPOS = &H402 Private Const PBM_SETRANGE32 = &H406 Private PrBar As LongPtr 'creation de la progeressbar Private Sub UserForm_Activate() Const WS_CHILD = &H40000000 'permet de créer une fenêtre sans caption(les fenêtres childs n'ont pas de barre de titre) Const WS_VISIBLE = &H10000000 'completement visible overlay 'Dim recta(0 To 3) As Long, I 'GetClientRect Frame1.[_GethWnd], recta(0) 'PrBar = CreateWindowExA(0, "msctls_progress32", _ "", WS_VISIBLE Or WS_CHILD, _ 0, 0, recta(2), recta(3), _ Frame1.[_GethWnd], 0, 0, 0) Dim r As rect GetClientRect Frame1.[_GethWnd], r PrBar = CreateWindowExA(0, "msctls_progress32", _ "", WS_VISIBLE Or WS_CHILD, _ r.left, 0, r.right - r.left, r.bottom - r.top, _ Frame1.[_GethWnd], 0, 0, 0) 'donner la progressbar la valeur min 1 et max de 1000 SendMessageA PrBar, PBM_SETRANGE32, 1, 1000 End Sub Private Sub CommandButton1_Click() Dim t As Single, I& t = Timer For I = 1 To 1000 SendMessageA PrBar, PBM_SETPOS, I, 0 While (Timer - t) < 0.01 DoEvents Wend t = Timer Next MsgBox "fin" End Sub

Cela dit pour que tout le monde comprenne
Quand on fait un getclientrect handle,rectangle(0) quand le rectangle() est un array
Implicitement l'api va te donner la largeur au lieu du right et la hauteur au lieu du bottom
Très peu de gens le savent ça, c'est pour ça que je disais belle pirouette cacahuète
mais cela implique une structure non typée comme "Any" pour l'API(capricieux en 64)

Belle démonstration en tout cas je n'y aurait pas pensé a creawindowexA type progress32
Belle alternative pour les office 64 je valide
Pour cathodique et les autres

Bonjour,

Je m'attendais à autre chose. C'est au final le même progressBar, géré en utilisant des Api.
Toujours aussi perspicace Patrick, merci beaucoup pour ton partage.
Bonne journée.

Cousinhub · 26 Décembre 2025

patricktoulon à dit:
Bonsoir à tous
Et c'est là que l'on voit les vieux baroudeurs
Joli !! @Rheeem 👍
il y a cependant une petite chose à régler
C’est de notoriété publique qu’office 64 /API n'aime pas trop le " As Any"
pas précis (possibilité de confondre Long/longptr)
En l'occurrence ici la pirouette cacahuète avec l'array 0 to 3 en long peut capoter en 64 bits pour la raison citée au dessus(hein vieux baroudeur)
Donc pour le coup changer l'argument dans la déclaration de l'api et ajouter la tructure rect

Mettre la variable handle en global module et le slide séparé afin d'être utilisable a tout moments.

VB:

Option Explicit 'd 'apres l'exemple de @Rheeem sur ExcelDownload 'correctif pour la structure rect explicitement rectangle Private Type rect left As Long top As Long right As Long bottom As Long End Type Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, _ ByVal lpWindowName As String, ByVal dwStyle As Long, _ ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _ ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr 'Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As any) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, recta As rect) As Long Private Const PBM_SETPOS = &H402 Private Const PBM_SETRANGE32 = &H406 Private PrBar As LongPtr 'creation de la progeressbar Private Sub UserForm_Activate() Const WS_CHILD = &H40000000 'permet de créer une fenêtre sans caption(les fenêtres childs n'ont pas de barre de titre) Const WS_VISIBLE = &H10000000 'completement visible overlay 'Dim recta(0 To 3) As Long, I 'GetClientRect Frame1.[_GethWnd], recta(0) 'PrBar = CreateWindowExA(0, "msctls_progress32", _ "", WS_VISIBLE Or WS_CHILD, _ 0, 0, recta(2), recta(3), _ Frame1.[_GethWnd], 0, 0, 0) Dim r As rect GetClientRect Frame1.[_GethWnd], r PrBar = CreateWindowExA(0, "msctls_progress32", _ "", WS_VISIBLE Or WS_CHILD, _ r.left, 0, r.right - r.left, r.bottom - r.top, _ Frame1.[_GethWnd], 0, 0, 0) 'donner la progressbar la valeur min 1 et max de 1000 SendMessageA PrBar, PBM_SETRANGE32, 1, 1000 End Sub Private Sub CommandButton1_Click() Dim t As Single, I& t = Timer For I = 1 To 1000 SendMessageA PrBar, PBM_SETPOS, I, 0 While (Timer - t) < 0.01 DoEvents Wend t = Timer Next MsgBox "fin" End Sub

Cela dit pour que tout le monde comprenne
Quand on fait un getclientrect handle,rectangle(0) quand le rectangle() est un array
Implicitement l'api va te donner la largeur au lieu du right et la hauteur au lieu du bottom
Très peu de gens le savent ça, c'est pour ça que je disais belle pirouette cacahuète
mais cela implique une structure non typée comme "Any" pour l'API(capricieux en 64)

Belle démonstration en tout cas je n'y aurait pas pensé a creawindowexA type progress32
Belle alternative pour les office 64 je valide
Pour cathodique et les autres

Hello Patrick....
Petit doute sur le "Office 64"

Ma config :
Office 2024

Windows 11 Famille 64b

Bonne journée

patricktoulon · 26 Décembre 2025

oups
Bonjour @Cousinhub oui tu a parfaitement raison

patricktoulon · 26 Décembre 2025

code corrigé

VB:

Option Explicit
'd 'apres l'exemple de @Rheeem sur ExcelDownload
'correctif  pour la structure rect explicitement rectangle
Private Type rect
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Declare PtrSafe Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, _
                              ByVal lpWindowName As String, ByVal dwStyle As Long, _
                              ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
                              ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _
                              ByVal hInstance As LongPtr, ByVal lpParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
'Private Declare  PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, rect As any) As Long
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, recta As rect) As Long

Private Const PBM_SETPOS = &H402
Private Const PBM_SETRANGE32 = &H406
Private PrBar As LongPtr

'creation de la progeressbar
Private Sub UserForm_Activate()
    Const WS_CHILD = &H40000000 'permet de créer une fenêtre sans caption(les fenêtres childs n'ont pas de barre de titre)
    Const WS_VISIBLE = &H10000000 'completement visible overlay
   #If Not Win64 Then
   MsgBox "La méthode d'insertion d'une progressbar par l'api ,est inutile en 32 bits":exit sub 
   #End If
   'Dim recta(0 To 3) As Long, I
    'GetClientRect Frame1.[_GethWnd], recta(0)
    'PrBar = CreateWindowExA(0, "msctls_progress32", _
                                 "", WS_VISIBLE Or WS_CHILD, _
                                 0, 0, recta(2), recta(3), _
                                 Frame1.[_GethWnd], 0, 0, 0)
   
    Dim r As rect
    GetClientRect Frame1.[_GethWnd], r
    PrBar = CreateWindowExA(0, "msctls_progress32", _
                                "", WS_VISIBLE Or WS_CHILD, _
                                r.left, 0, r.right - r.left, r.bottom - r.top, _
                                Frame1.[_GethWnd], 0, 0, 0)
   
   
    'donner la progressbar la valeur min 1 et max de 1000
    SendMessageA PrBar, PBM_SETRANGE32, 1, 1000
   
End Sub



Private Sub CommandButton1_Click()
   #If Not Win64 Then
   MsgBox "La méthode d'insertion d'une progressbar par l'api ,est inutile en 32 bits":exit sub"
   #End If
    Dim t As Single, I&
    t = Timer
    For I = 1 To 1000
        SendMessageA PrBar, PBM_SETPOS, I, 0
        While (Timer - t) < 0.01
            DoEvents
        Wend
        t = Timer
    Next
    MsgBox "fin"
End Sub

Cousinhub · 26 Décembre 2025

Re-,
Effectivement, ça marche mieux
Cependant, double apparition de ce msg :

Et ensuite, la progress bar "progresse" bien 🙂

Autres Problème de Progress Bar (erreur d'ocx)

DenisHen

XLDnaute Junior

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Pièces jointes

Rheeem

XLDnaute Occasionnel

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

Autres Problème de Progress Bar (erreur d'ocx)

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Privacy & Transparency

Privacy & Transparency