UserForm et Macro en même temps

Stikmou -  
Bonjour,

Après de multiples recherches, je n'ai pas trouvé réponse à ma question, j'aimerais savoir comment peut-on faire tourner un UserForm et une macro en même temps, avec le UserForm en premier plan ?

Merci d'avance

6 réponses

  1.  Polux31
    Bonjour,

    Peut être avec un peu plus de détails ... nous n'avons pas tous pris l'option "Divination" dans notre cursus !!!
    1. Stikmou
      En gros, j'ai une macro qui tourne et ouvre à un moment donné un UserForm. J'aimerais que le code du UserForm s'exécute pendant que celui de la macro continue à tourner lui aussi.
      Je ne sais pas si c'est possible, pour l'instant j'ai compris la notion de modal ou non modal. Mais en mode Non Modal, mon UserForm s'affiche mais le code dedans ne s'exécute pas car il laisse place à la macro et en mode Modal, le code du UserForm s'exécute et ensuite se finit celui de la macro.
      1. Stikmou
        J'aurais besoin d'un peu d'aide, svp.
      2. Stikmou
        Je suis vraiment bloquée et ne trouve pas la solution, personne ne sait comment m'aider ?

        Merci d'avance
      3. Iama
        Bonjour
        Pour de ma part non, je pense qu'un ordinateur ne peux pas faire deux choses en même temps
        cordialement
    2. pijaku Modérateur
      Bonjour,

      Pour pouvoir répondre à cette question, il nous faut davantage de précisions.
      Que fait la macro? son code?
      Pourquoi un Userform? y a t'il une (des) action de l'utilisateur? Code du Userform?
      Etc......

      Un fichier exemple ne serait pas non plus superflu.
      1. Stikmou
        Bonjour,

        La macro sert à importer les données d'un autre fichier dans le fichier courant. Pour ça il vérifie si le fichier courant est vide, s'il ne l'est pas il demande si l'on veut écraser les valeurs ou annuler. Une fois cette étape il ouvre le fichier à importer.
        A ce moment s'ouvre l'userform, celui-ci est une barre de progression que j'aimerais faire progresser durant l'avancement de la macro. Connaissant le temps d'exécution de ma macro, j'ai fait une barre de progression en fonction de ce temps, voici le code de l'UserForm :

        Private Sub UserForm_Activate()
        Dim T As Double

        compteur = Timer
        progression = 0
        compteur = Application.Round((Timer - T), 1)

        While progression < 100
        If Timer > compteur + 0.4 Then
        compteur = compteur + 0.4
        progression = progression + 1
        Image_barre.Width = progression * 2.22
        Label_barre.Caption = progression & "%"
        DoEvents
        End If
        Wend

        Application.ScreenUpdating = True
        UserForm3.Height = 91.5
        End Sub

        Après l'ouverture du UserForm, la macro va chercher chaque donnée à des endroits précis et les recopie dans le fichier courant, le code est assez conséquent alors si vous n'avez pas compris je peux le mettre mais bon...

        Le problème c'est que quand j'ouvre le UserForm il exécute le code ci-dessus et met en pause celui de la macro et une fois la barre remplie il exécute le code la macro ce qui n'a aucun intérêt et si je met le UserForm en mode non modal alors il s'ouvre affiche la barre vide, et exécute le code de la macro sans jamais modifier la barre de progression, ce qui n'a aucun intérêt non plus. Il faudrait que les deux codes s'exécutent en même temps.

        En espérant avoir été clair.

        Merci de vos réponses, en attente de la solution...
        2. pijaku Modérateur
          Alors il convient de "couper" ta macro en trois parties. 
          Sub DebutProcedure
    'ici tu mets tout ton code jusqu'à l'ouverture de l'USF
End Sub 

Private Sub UserForm_Activate()
    'ici tu mets ton code d'import de données ET de barre de progression
Call FinProcedure
End Sub 
 
Sub FinProcedure
    'ici tu mets tout ton code après fermeture de l'USF
End Sub
          1. Stikmou
            Le problème c'est que le code pour faire augmenter la barre de progression est une boucle contrairement à celui de la macro donc je ne vois pas comment associer les deux ?
            Sinon ne peut-on pas faire que la macro se mette en pause dès que la condition du code du UserForm est vérifié est exécute le code et reprenne la lecture de la macro ?
          2. pijaku Modérateur
            Pour te répondre il me faut le code de ladite macro.....
          3. Stikmou 
            Sub Import_NOM()

            '                       ***********************************************************************************
            '                       **********                   IMPORTER UNE NOMENCLATURE                   **********
            '                       ***********************************************************************************

            Dim FindTranslate As Boolean, DemandSAP As Boolean
            Dim fichier
            Dim appexcel As Excel.Application
            Dim wbexcel As Excel.Workbook
            Dim nom As String

            Application.EnableEvents = False

            ' Désactivation de l'écran pendant le calcul
            Application.ScreenUpdating = False
            ' Activation du Sablier
            Application.Cursor = xlWait

            'passer en calcul manuel
            With Application
                .Calculation = xlManual
                .MaxChange = 0.001
            End With

            CurrentWorkbooks = ActiveWorkbook.Name
                
            '------------------------------------------------------------
            '--              Ouverture base de donnée SAP              ---
            '------------------------------------------------------------
                OpenBdSAP
                Application.EnableEvents = False

            'Tri croissant par repère de l'onglet pièces usinées
            Worksheets("PIECES USINEES").Select
            Range("A115:CE1000").Sort Key1:=Range("A114"), Order1:=xlAscending, Header _
                :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
                , DataOption1:=xlSortNormal

            'Tri croissant par repère de l'onglet pièces commerces
            Worksheets("PIECES COMMERCES").Select
            Range("A13:CE1000").Sort Key1:=Range("A12"), Order1:=xlAscending, Header _
                :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
                , DataOption1:=xlSortNormal

            '-------------------------------------------------------------
            '--  Affichage du Msgbox si la nomenclature n'est pas vide ---
            '-------------------------------------------------------------
            If Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(115, 1).Value <> "" Or Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(13, 1).Value <> "" Then
                Worksheets("PIECES USINEES").Select
            '-------------------------------------------------------------
            '--    Définition des paramètres du Msgbox selon le pays   ---
            '-------------------------------------------------------------

                        titre = Workbooks(CurrentWorkbooks).Worksheets("TABLEAU_TRADUCTION").Cells(5, 108).Value
                        texte = Workbooks(CurrentWorkbooks).Worksheets("TABLEAU_TRADUCTION").Cells(6, 108).Value
                    
                If MsgBox(texte, vbYesNo + vbQuestion + vbDefaultButton2, titre) = vbNo Then
                    Exit Sub
                End If

            '-------------------------------------------------------------
            '--      Suppression des données onglet pièces usinées     ---
            '-------------------------------------------------------------
                suppression_données_usinées
                Application.EnableEvents = False

            '-------------------------------------------------------------
            '--     Suppression des données onglet pièces commerces    ---
            '-------------------------------------------------------------
                suppression_données_commerces
                Application.EnableEvents = False

            '-------------------------------------------------------------
            '--         Mise à blanc de l'onglet pièces usinées        ---
            '-------------------------------------------------------------
                blanc
                Application.EnableEvents = False
                
            '-------------------------------------------------------------
            '--         Mise à blanc de l'onglet pièces commerces      ---
            '-------------------------------------------------------------
                blanccom
                Application.EnableEvents = False
                
            End If

            Worksheets("PIECES USINEES").Select
            'verification fichier a importer
            nom = ""
                Dim FSO
            Set FSO = CreateObject("Scripting.FileSystemObject")
            nom = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")

                'Mise en place d'une barre de chargement
                'UserForm3.Show False

            If FSO.Fileexists(nom) = False Then Exit Sub
            NomName = FSO.Getfilename(nom)
            On Error Resume Next
            'ouverture du fichier a importer
            Workbooks.Open (nom)
            ImportWorkbooks = NomName
            Workbooks(CurrentWorkbooks).Activate

            ' Désactivation de l'écran pendant le calcul
            Application.ScreenUpdating = False
            ' Activation du Sablier
            Application.Cursor = xlWait

            'passer en calcul manuel
            With Application
                .Calculation = xlManual
                .MaxChange = 0.001
            End With

            '--------------------------------------------------------
            '--          Copie du cartouche pièce usinée          ---
            '--------------------------------------------------------

            'Client (103-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(103, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 5).Value
            End If
            'Projet (103-8)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 8).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(103, 8).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 8).Value
            End If
            'Désignation outil (103-10)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 10).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(103, 10).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(103, 10).Value
            End If
            'OTP CZ (104-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(104, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(104, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(104, 5).Value
            End If
            'OTP FR (105-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(105, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(105, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(105, 5).Value
            End If
            'OP (105-7)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(105, 7).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(105, 7).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(105, 7).Value
            End If
            'Sous OTP (105-9) non car info fixe
            'Nature OTP (107-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(107, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(107, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(107, 5).Value
            End If
            'Dessinateur (109-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(109, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(109, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(109, 5).Value
            End If
            'RAL (111-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(111, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(111, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(111, 5).Value
            End If
            'PAYS (110-5)
            If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(110, 5).Value <> 0 Then
                Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(110, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(110, 5).Value
            End If
            'Encart de Modif
            For i = 101 To 111
                For j = 16 To 18
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, j).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, j).Value
                Next j
            Next i

            '--------------------------------------------------------
            '--          Copie des données pièce usinée           ---
            '--------------------------------------------------------

            'Tri croissant par repère de l'onglet pièces usinées du fichier à importer
            Workbooks(ImportWorkbooks).Activate
            Worksheets("PIECES USINEES").Select
            Range("A115:CE1000").Sort Key1:=Range("A114"), Order1:=xlAscending, Header _
                :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
                , DataOption1:=xlSortNormal
            Workbooks(CurrentWorkbooks).Activate

            'Copie des données de la nomenclature
            i = 115

            'Boucle sur toutes les lignes pour import des données
            While (Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 1).Value <> 0)
                
                'Repère(1)-Nombre(2)-Désignation(3)-Matière(4)-Traitement(5)-Dureté(6)-Revetement(7)-Jeu de découpe(8)-Cotes finies(9-10-11)
                For k = 1 To 11
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'Poids(12)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 12).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, 12).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 12).Value
                End If
                'Format d'appro(13)-Observation(14)-plan(15)-Nom(16)-Date(17)-Version(18)-Commentaires(19)-HAnom(20)-HADate(21)-HAInd(22)-HADélai(23)
                '-HADateLiv(24)-HAEtat(25)-HAcotes(26-27-28)-HAtol(29-30-31)
                For k = 13 To 31
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'HAcommentaires(34)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 34).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i + ShiftI, 34).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 34).Value
                End If
                'Article matiere(35)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 35).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, 35).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 35).Value
                End If
                'HATnom(40)-HATdate(41)-HATdélai(42)-HATquantité(43)
                For k = 40 To 43
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'Article traitement(44)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 44).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, 44).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 44).Value
                End If
                'HARnom(49)-HARdate(50)-HARdélai(51)
                For k = 49 To 51
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'Article revetement(53)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 53).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, 53).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 53).Value
                End If
                'HAUnom(58)-HAUdate(59)-HAUdélai(60)
                For k = 58 To 60
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'Article usinage(62)
                If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 62).Value <> 0 Then
                    Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, 62).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 62).Value
                End If
                'Lancement(67)-Date(68)-Phase(69)-CDC(70)-Logiciel(71)-Commentaires(72)-ValidationMTH(73-74-75-76)-ValidationPF(77-78-79)
                'MontageSE(80)-Esprit(81)-WorkNc(82)-Usinage(83)-Usinage Divers(84)-ElectroErosion(85)-Montage et Map(86-89)-Sym(91)
                For k = 67 To 91
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, k).Value
                    End If
                Next k
                'Passage à la ligne suivante
                i = i + 1
            Wend

            '--------------------------------------------------------
            '--        Copie des données pièces commerces         ---
            '--------------------------------------------------------

            'Tri croissant par repère du fichier à importer commerce
            Workbooks(ImportWorkbooks).Activate
            Worksheets("PIECES COMMERCES").Select
            Range("A13:W1000").Sort Key1:=Range("A13"), Order1:=xlAscending, Header _
                :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
                , DataOption1:=xlSortNormal
            Workbooks(CurrentWorkbooks).Activate

            'Ligne départ lecture import - à convertir avec ouverture du fichier récupéré sans copie dans fichier courant
            i = 13

            'Boucle sur toutes les lignes pour import des données
            While (Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 1).Value <> 0)
                
                'Repère(1)-Nombre(2)
                For k = 1 To 2
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value
                    End If
                Next k
                
                'Reference (4)
                For k = 4 To 4
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value
                    End If
                Next k
                
                'Imposé(6)-ObsTechnique(7)-Nom(8)-Date(9)-Version(10)-CommentairesBE(11)-Demandeur(12)-Date(13)-Delai souhaité(14)
                For k = 6 To 14
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value
                    End If
                Next k
                
                 'Montage ss ensemble(20)-Tps Montage(21)
                For k = 20 To 21
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, k).Value
                    End If
                Next k
                
                'MABEC(26)
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 26).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 26).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 26).Value
                    End If
                
                'Passage à la ligne suivante
                i = i + 1
                
            Wend
                
            'passer en calcul automatique
            With Application
                .Calculation = xlAutomatic
                .MaxChange = 0.001
            End With

            'passer en calcul manuel
            With Application
                .Calculation = xlManual
                .MaxChange = 0.001
            End With

            '--------------------------------------------------------
            '--    Copie de la désignation et du fournisseur      ---
            '--------------------------------------------------------
            'SI REF OK dans SAP on ne copie pas la designation et le fournisseur. C'est récupéré automatiquement de la base SAP
            'Si demande SAP colonne O alors copie de la designation et du fournissuer de la nom à importée
            'Si REF FOURNISSEUR VIDE alors copie de la designation et du fournissuer de la nom à importée

            'Ligne départ lecture import - à convertir avec ouverture du fichier récupéré sans copie dans fichier courant
            i = 13

            'Boucle sur toutes les lignes pour import des données
            While (Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 1).Value <> 0)
              
                'Vérification si "Demande SAP" ou si ligne remplie sans ref fournisseur
                DemandSAP = False
                If Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 15).Value = "DEMANDE SAP" Or Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 15).Value = "" Then
                   DemandSAP = True
                End If
                
                If DemandSAP Then 'Si demande SAP et Désignation ou fournisseur renseignés dans la nomenclature à importer
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 3).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 3).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 3).Value
                    End If
                    
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 5).Value <> 0 Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 5).Value = Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 5).Value
                    End If
                End If
                
                'Passage à la ligne suivante
                i = i + 1
                
            Wend

            'Recup Format barre
                'Onglet PIECES USINEES
                i = 115
                While Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 1).Value <> 0
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES USINEES").Cells(i, 1).Font.Strikethrough Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Rows(i).EntireRow.Font.Strikethrough = True
                    End If
                    i = i + 1
                Wend
                'Onglet PIECES COMMERCES
                i = 13
                While Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 1).Value <> 0
                    If Workbooks(ImportWorkbooks).Worksheets("PIECES COMMERCES").Cells(i, 1).Font.Strikethrough Then
                        Workbooks(CurrentWorkbooks).Worksheets("PIECES COMMERCES").Rows(i).EntireRow.Font.Strikethrough = True
                    End If
                    i = i + 1
                Wend
                
                MAJ_designation_ref_tout
                
            Application.EnableEvents = False

            'passer en calcul automatique
            With Application
                .Calculation = xlAutomatic
                .MaxChange = 0.001
            End With

            Workbooks(CurrentWorkbooks).Worksheets("PIECES USINEES").Select

            ' Désactivation du sablier
            Application.Cursor = xlDefault
            ' Activation de l'écran à la fin des calculs
            Application.ScreenUpdating = True

            MsgBox "L'importation de la nomenclature est terminée."

            Application.EnableEvents = True

            End Sub
        3.  pijaku Modérateur
          Comme tu n'as pas de boucle, ce que tu veux faire, dans l'état, est impossible.

          Par contre, tu peux créer une Sub Progression et l'appeler à différents endroits de ton code.

          Par exemple : https://www.cjoint.com/c/DHzpoZzpoaR 

          Sub Progression()
UserForm1.Label1.Move UserForm1.Label1.Left, UserForm1.Label1.Top, UserForm1.Label1.Width + 10, UserForm1.Label1.Height
UserForm1.Repaint
End Sub


          Avec le code d'appel dans ta procédure principale : 
          Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub vazy()
  Cells(1, 1) = 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Load UserForm1
  UserForm1.Show vbModeless
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  
  Progression
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  UserForm1.Hide
  Unload UserForm1
  
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
  Sleep 1000
  Cells(1, 1) = Cells(1, 1) + 1
End Sub
          1. Stikmou
            Merci beaucoup pour tes réponses et ta solution, je vais essayer prochainement, je te tiens au courant :).

        Discussions similaires

        Temps d’écran « ignorer la limite »
        karnameismy

        16 réponses
        Pourquoi l'info "actif depuis "x" minutes" n'apparaît plus ?
        Uhlrich

        11 réponses
        Durée du sablier Snapchat
        Snapeeejdvjz

        7 réponses
        Transformer un chiffre en lettres dans excel sans macro
        vincentphilippos

        6 réponses
        Les meilleurs amis snapchat changent en combien de temps?
        jhuifcehrg

        5 réponses