Sujet Précédent Sujet Suivant

UserForm et Macro en même temps

Fermé
Stikmou - 20 août 2014 à 16:46
 Stikmou - 25 août 2014 à 15:23
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
A voir également:

6 réponses

Réponse 1 / 6
Polux31 Messages postés 6917 Date d'inscription mardi 25 septembre 2007 Statut Membre Dernière intervention 1 novembre 2016 1 204
20 août 2014 à 16:58
Bonjour,

Peut être avec un peu plus de détails ... nous n'avons pas tous pris l'option "Divination" dans notre cursus !!!
0
Réponse 2 / 6
Stikmou
20 août 2014 à 17:14
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.
0
Stikmou
21 août 2014 à 16:14
J'aurais besoin d'un peu d'aide, svp.
0
Stikmou
25 août 2014 à 09:15
Je suis vraiment bloquée et ne trouve pas la solution, personne ne sait comment m'aider ?

Merci d'avance
0
Iama Messages postés 319 Date d'inscription mercredi 13 janvier 2010 Statut Membre Dernière intervention 27 mars 2020 14
25 août 2014 à 09:24
Bonjour
Pour de ma part non, je pense qu'un ordinateur ne peux pas faire deux choses en même temps
cordialement
0
Réponse 3 / 6
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
25 août 2014 à 10:58
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.
0
Réponse 4 / 6
Stikmou
25 août 2014 à 12:15
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...
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
25 août 2014 à 13:19
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
0
Stikmou
25 août 2014 à 13:58
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 ?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
25 août 2014 à 14:02
Pour te répondre il me faut le code de ladite macro.....
0
Stikmou
25 août 2014 à 14:13 
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
0
Réponse 6 / 6
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
25 août 2014 à 15:15
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
0
Stikmou
25 août 2014 à 15:23
Merci beaucoup pour tes réponses et ta solution, je vais essayer prochainement, je te tiens au courant :).
0

Discussions similaires

Acces à snapchat temporairement désactivé
Anto_1234 -
M2 -

87 réponses
comment voir une image satellite en direct
antoin e22120 -
Creeks89 -

10 réponses
Je tiens combien de temps avec 2Go d'internet ?
champi100 -
dadout -

7 réponses
Colis SHEIN
Louise -
Jean -

28 réponses