Débogage Macro: Absence de commande [Résolu]

Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
J'ai un classeur avec plusieurs feuilles et une de ces feuilles est la synthèse de toutes les autres.
De base toute donnés sont extraits d'un logiciel de gestion de l'entreprise.
J'ai créé une macro, Alors lorsque je fais la <"synthèse par date et client"> où par <"date et commande"> sur mon macro, après utilisation j'ai remarqué :
- Qu'il y a certains éléments qui ne se sont pas rajoutés sur ma feuille 'synthèse'.
- Dans ma colonne stock Théorique, les calculs ne sont pas corrects alors que dans mes fonctions tout est bon.
- Les commandes ayant un même code article et même date ne s'affichent pas. Au lieu que ça se rajoute comme une suite, la commande disparaît ou supprime la précédente ou même il n'y a rien.

Et quel est la meilleure méthode pour faire un lien entre 3 colonnes différentes? Moi, je n'ai trouvé que de le faire par commentaire. Mais il n'y a pas d’autres méthodes plus adéquates et propres?

Malheureusement je ne trouve pas la possibilité de joindre le fichier .xls sur ce site :(

ça m'inquiets un peu. Alors cherches à savoir si c'est mes codes qui posent problèmes où cela vient du logiciel d'où j'extrais toute ces données.

Que me conseillez-vous?

Merci de me venir en aide!
Afficher la suite 

3 réponses

Meilleure réponse
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46
1
Merci
la première chose que je vois c'est que tu utilises plusieurs fois
Application.ScreenUpdating = False
mais tu ne le repasse jamais à
True
..

sinon un détail sur la durée du workbook open, tu peux remplacer ça
For r = 1 To r

Sheets("Synthese").Range("AH" & r) = "=IF(RC[-15]="""","""",IF(ISNA(VLOOKUP(RC[-15],Commentaires!C[-33]:C[-31],3,FALSE)),"""",VLOOKUP(RC[-15],Commentaires!C[-33]:C[-31],3,FALSE)))"

Next

par ça
Sheets("Synthese").Range("AH1:AH" & r) = "=IF(RC[-15]="""","""",IF(ISNA(VLOOKUP(RC[-15],Commentaires!C[-33]:C[-31],3,FALSE)),"""",VLOOKUP(RC[-15],Commentaires!C[-33]:C[-31],3,FALSE)))"

c'est infiniment plus rapide

vérifie déjà si notre histoire de
Application.ScreenUpdating = True
ne joue pas sur les données que tu ne retrouve pas et les calculs qui sont erronés, sinon reviens avec plus de détails sur les parties qui te semblent ne pas bien fonctionner parce que là ça fait beaucoup à éplucher

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 63884 internautes nous ont dit merci ce mois-ci

Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
bonjour fabien25000,
après vérification il y a bel et bien un problème sur < Application.ScreenUpdating = True >
Commenter la réponse de fabien25000
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46
0
Merci
Bonjour,

Sans voir le code, pas possible de t’aider à trouver le problème...

Toujours est il que dans la vba si ta macro ne fait pas ce que tu attends c’est que c’est vraisemblablement mal écrit ..
Tu peux toujours recréer les situations ou les calculs ne se font pas comme tu le veux et voir au pas a pas (mettre un point d’arrêt et défiler ligne par ligne avec F8) comment réagis ta macro
Tu peux peut-être créer un fichier exemple avec le cas de figure à corriger afin qu’on puisse t’aider
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
Bonjour fabien25000, vous avez raison je crois que je ferai la procédure avec F8, et le faire défiler ligne par ligne, il y a surement un petit détail sur mes codes que je dois revoir. Merci de m'être venu en aide !

J'aimerai bien joindre le fichier mais triste à constater qu'il n'y a pas ou joindre un document sur ce site... :(
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
Option Explicit

Sub AfficherDelais(ByVal ligneRes As Integer, ByVal delai As Single)
    Dim dateLiv As Date, today As Date
    Dim retard As Single
    today = Date
    If ligneRes > 0 Then
    With shSynthese
        dateLiv = CDate(.Cells(ligneRes, 18))
       retard = CInt((today - dateLiv + delai) * 10) / 10
        delai = CInt(10 * delai) / 10
       .Cells(ligneRes, 27) = delai & " jrs"
        
        If retard > 0 Then
            .Cells(ligneRes, 28).Value = retard & " jrs"
            .Cells(ligneRes, 28).Font.Color = RGB(255, 0, 0)
        End If
    
        .Range("R" & ligneRes & ":AB" & ligneRes).Borders(xlEdgeTop).LineStyle = xlDash
    End With    'shSynthese
    End If
End Sub
Function GetInfosCC(ByRef CC As String, ByVal tpsRestant As Single, ByRef tpsAttente As Single) As Single
    Dim ligne As Integer
    
    ligne = 1
    
    With shCC
        'TQ on a pas trouvé le centre de charge mais qu'il reste des lignes
        While .Cells(ligne, 1).Value <> CC And .Cells(ligne, 1).Value <> ""
            ligne = ligne + 1
        Wend    'Fin TQ on a pas trouvé le centre de charge
        
        'Si on a trouvé le centre de charge
        If .Cells(ligne, 1).Value = CC Then
            tpsAttente = .Cells(ligne, 3)
            
            'Si on a pas de capacité (sous-traitance)
            If .Cells(ligne, 8) = "" Then
                GetInfosCC = 0
            Else
                GetInfosCC = tpsRestant / .Cells(ligne, 8)
            End If  'Fin si on a pas de capacité
        Else
            tpsAttente = 0
            GetInfosCC = 0
        End If  'Fin si on a trouvé le centre de charge
    End With    'shCC
End Function

Private Sub CheckChk()
    If chkCC.Value = True And chkCommandes.Value = True And chkOA.Value = True And chkOF.Value = True And chkOFMontage.Value = True Then
        chkTout.Value = True
    ElseIf chkCC.Value = False And chkCommandes.Value = False And chkOA.Value = False And chkOF.Value = False And chkOFMontage.Value = False Then
        chkTout.Value = False
    Else
        chkTout.Value = Null
    End If
End Sub

Private Sub chkCC_Click()
    Call CheckChk
End Sub
Private Sub chkCommandes_Click()
    Call CheckChk
End Sub
Private Sub chkOA_Click()
   Call CheckChk
End Sub
Private Sub chkOF_Click()
    Call CheckChk
End Sub
Private Sub chkOFMontage_Click()
    Call CheckChk
End Sub

Private Sub chkTout_Click()
    Dim etat As Boolean
    
    etat = chkTout.Value
    
    chkCC.Value = etat
    chkCommandes.Value = etat
    chkOA.Value = etat
    chkOF.Value = etat
    chkOFMontage = etat

End Sub

Function CopyOA(projet, article, ByVal ligneRes As Integer, OA As Integer)

    Dim lastTop(5)
    
    Dim res As Range
    Dim firstAddress As String
    
    Dim ligneOA As Long
    Dim colOA As Integer
    
    
    'nb d'OA correspondants à la commande
    OA = 0
    
    'Application.ScreenUpdating = False
    
    With shOA
        Set res = .Range("B:B").Find(What:=article, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
            :=False, SearchFormat:=False)
    
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                ligneOA = res.Row
        
                If .Cells(ligneOA, 1) = projet And res.Value = article Then
                    For colOA = 3 To 7
                        If OA = 0 Or .Cells(ligneOA, colOA).Value <> lastTop(colOA - 2) Then
                            shSynthese.Cells(ligneRes, colOA + 26).Value = .Cells(ligneOA, colOA).Value
                            lastTop(colOA - 2) = .Cells(ligneOA, colOA).Value
                        End If
                        
                    Next colOA
                    
                    OA = OA + 1
                    ligneRes = ligneRes + 1
                End If
                Set res = .Range("B:B").FindNext(After:=res)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With    'shOA
    
    If OA > 0 Then
        With shSynthese.Range("AC" & ligneRes - OA & ":AG" & ligneRes - 1)
            'bordure épaisse :
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeRight).Weight = xlMedium
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlEdgeBottom).Weight = xlMedium
        
            'couleur de cellules : blanc
            .Interior.Color = RGB(255, 255, 255)
        End With    'shSynthese.Range("AC" & ligneRes - oa & ":AG" & ligneRes - 1)
    End If
End Function

Function CopyOF(projet, article, ByVal ligneRes As Integer, of As Integer)

    Dim lastTop(14)
    Dim nbTabOF As Integer
    
    Dim res As Range
    Dim delai As Single, tpsAttente As Single, capacite As Single
    
    Dim firstAddress As String
    Dim ligneDebut As Long, ligneOF As Long
    Dim colOF As Integer
    

    
    'nb d'OF correspondants à la commande
    of = 0
    ligneDebut = 0
    
    
    With shOF
        Set res = .Range("B:B").Find(What:=article, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
            :=False, SearchFormat:=False)
    
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                ligneOF = res.Row
                
                'Si la ligne d'OF correspond
                If .Cells(ligneOF, 1) = projet And res.Value = article Then
                
                    'Si même OF
                    If .Cells(ligneOF, 4) = lastTop(2) Then
                        delai = delai + tpsAttente      'Ajout du temps d'attente précédent
                        delai = delai + GetInfosCC(.Cells(ligneOF, 8), .Cells(ligneOF, 10) - .Cells(ligneOF, 11), tpsAttente)
                    
                        For colOF = 3 To 11
                            'Si un nouvel OF
                            If colOF > 7 Or of = 0 Or .Cells(ligneOF, colOF).Value <> lastTop(colOF - 2) Then
                                shSynthese.Cells(ligneRes, colOF + 15).Value = .Cells(ligneOF, colOF).Value
                                lastTop(colOF - 2) = .Cells(ligneOF, colOF).Value
                                
                                'On enregistre l'OF
                                ReDim tabOF(nbTabOF + 1)
                                tabOF(nbTabOF) = .Cells(ligneOF, 4).Value
                                nbTabOF = nbTabOF + 1
                            End If  'Fin si un nouvel OF
                        Next colOF
                    Else
                        For colOF = 3 To 11
                            'On réaffiche toutes les informations
                            shSynthese.Cells(ligneRes, colOF + 15).Value = .Cells(ligneOF, colOF).Value
                            lastTop(colOF - 2) = .Cells(ligneOF, colOF).Value
                            
                            'On enregistre l'OF
                            ReDim tabOF(nbTabOF + 1)
                            tabOF(nbTabOF) = .Cells(ligneOF, 4).Value
                            nbTabOF = nbTabOF + 1
                            'Fin si un nouvel OF
                        Next colOF
                        
                        
                        'Si on a déjà fait un OF avant :
                        If ligneDebut <> 0 Then
                            Call AfficherDelais(ligneDebut, delai)
                        End If  'Fin si on a déjà fait un OF avant
                        
                        ligneDebut = ligneRes
                        delai = GetInfosCC(.Cells(ligneOF, 8), .Cells(ligneOF, 10) - .Cells(ligneOF, 11), tpsAttente)
                    End If  'Fin si même OF
                    
                    'Si sous-traitance
                    If .Cells(ligneOF, 12) <> "" Then
                        For colOF = 12 To 16
                            If of = 0 Or .Cells(ligneOF, colOF).Value <> lastTop(colOF - 2) Then
                                shSynthese.Cells(ligneRes, colOF + 17).Value = .Cells(ligneOF, colOF).Value
                                lastTop(colOF - 2) = .Cells(ligneOF, colOF).Value
                            End If
                        Next colOF
                        shSynthese.Range("AC" & ligneRes & ":AG" & ligneRes).Interior.Color = RGB(255, 255, 255)
                    End If
                    
                    of = of + 1
                    ligneRes = ligneRes + 1
                End If
                Set res = .Range("B:B").FindNext(After:=res)
            Loop While Not res Is Nothing And res.Address <> firstAddress
            
            'Affichage du délai et du retard
            Call AfficherDelais(ligneDebut, delai)
        End If
    End With    'shOF
    If of > 0 Then
        With shSynthese.Range("R" & ligneRes - of & ":AB" & ligneRes - 1)
            'bordure épaisse :
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeRight).Weight = xlMedium
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlEdgeBottom).Weight = xlMedium
            
            'couleur de cellules : blanc
            .Interior.Color = RGB(255, 255, 255)
        End With 'shSynthese.Range("R" & ligneRes - of & ":AB" & ligneRes - 1)
    End If
    shSynthese.Activate
End Function
Function CheckOFMontage(ByRef article As String, ByRef dateDebut As Date, ByRef dateFin As Date) As Integer
    Dim besoin As Integer
    Dim res As Range
    Dim firstAddress As String
    Dim ligne As Long
    
    besoin = 0
    
    With shOFMontage
        Set res = .Range("B:B").Find(What:=article, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
            :=False, SearchFormat:=False)
    
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                ligne = res.Row
                
                'Les ventes sont prioritaires
                If .Cells(ligne, 3) >= dateDebut And .Cells(ligne, 3) < dateFin Then
                    besoin = besoin + .Cells(ligne, 8)
                    dateDebut = .Cells(ligne, 3)
                End If
            
                Set res = .Range("B:B").FindNext(After:=res)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With    'shOFMontage
    CheckOFMontage = besoin
End Function
'Renvoie Vrai si les stocks ne sont pas suffisants pour honorer la commande
Function CheckStocks(ByRef restants() As QteStock, ByRef nbLus As Integer, ByVal article As String, ByVal besoin As Integer, ByVal stock, ByVal ladate As Date) As Long
    Dim i As Integer
    i = 1
    While i <= nbLus And restants(i).article <> article
        i = i + 1
    Wend
    
    'si on a déjà lu l'article recherché
    If i <= nbLus Then
        restants(i).stock = restants(i).stock - besoin
    'sinon, on lit l'article pour la première fois
    Else
        'ajout de l'article
        restants(i).stock = stock - besoin
        restants(i).article = article
        restants(i).dateBesoin = CDate("1 / 1 / 1900")
        nbLus = nbLus + 1
    End If
    
    restants(i).stock = restants(i).stock - CheckOFMontage(article, restants(i).dateBesoin, ladate)
    restants(i).dateBesoin = ladate
    
    'les stocks suffisent-ils à satisfaire la commande en cours ?
    CheckStocks = restants(i).stock
End Function

Private Sub CleanImports()
    shCommande.Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    shOF.Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    shOA.Range("A:IV").Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    
    shCommande.Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    shOF.Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    shOA.Range("A:IV").Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End Sub
Private Sub MakeSynthese()
    Dim restants() As QteStock      'tableau du stock restant pour chaque article lu
    Dim articlesLus As Integer       'nombre d'articles lus
    Dim stockTheo As Long
    
    Dim nbOF As Integer
    Dim nbOA As Integer
    
    Dim ligneRes As Long, ligneCmd As Long
    Dim col As Integer
    
    Dim ensemble As String, projet As String, article As String
    Dim lastEnsemble As String, lastProjet As String, lastArticle As String
    
    
    ReDim restants(shCommande.Range("A:A").End(xlDown).Row)
    With shSynthese
        .Activate
        With .Range("A:IV")
            'Effacement des bordures sur la feuille
            .Borders.LineStyle = xlLineStyleNone
            
            'couleur de cellules : gris
            .Interior.Pattern = xlPatternNone
            .Interior.Color = RGB(192, 192, 192)
            .ClearContents
            .Font.Color = RGB(0, 0, 0)
            .Font.Bold = False
        End With    '.Range ("A:IV")
        
        .Range("A1:AG1") = Array("Date", "Cde", "Client", "Nom", "Lg", "Projet", "Code article", "Description", "Qté cdée", "A livrer", _
                                    "Code article", "Description", "Besoin", "Sto phy", "Sto cde", "Sto rés", "Sto théo", "Livr", "OF", "Qté plan", " Qté réal", "Opé", " CC", "Description", "Tps all", " Temps pass", "Délai", "Retard", _
                                    "N° ordre", "Fourn", "pos", "Qté rest", "Récept")
        .Range("A1:AG1").Font.Bold = True
        .Range("A1:J1").Interior.Color = RGB(0, 0, 255)
        .Range("A1:J1").Font.Color = RGB(255, 255, 255)
        .Range("K1:Q1").Interior.Color = RGB(255, 255, 128)
        .Range("R1:AB1").Interior.Color = RGB(255, 192, 128)
        .Range("AC1:AG1").Interior.Color = RGB(192, 255, 128)
        
        Call AnnulerFusionCellules
        
        
    End With
    
    'nb de ligne ds la feuille finale
    ligneRes = 2
    ensemble = "aaaaaaaaaaaaaaaaa"
    projet = "aaaaaaaaaaaaaaaaaaa"
    article = ""
    'Pour chaque commande
    
    articlesLus = 0 'on n'a détecté aucun article
    ligneCmd = 6    '1ère ligne du carnet de commandes à prendre en compte
    
    With shSynthese
        
        While shCommande.Cells(ligneCmd, 1) <> ""
            'ligneRes = ligneRes + 1
            
            lastEnsemble = ensemble
            lastProjet = projet
            lastArticle = article
            
            ensemble = shCommande.Cells(ligneCmd, 7)
            projet = shCommande.Cells(ligneCmd, 6)
            article = shCommande.Cells(ligneCmd, 12)
                
            'si la ligne correspond à un nouvel article on l'affiche
            If ensemble <> lastEnsemble Or projet <> lastProjet And (projet <> "" Or lastProjet <> "") Then
                'Si ni OA ni OF pour l'article précédent trouvés
                If .Cells(ligneRes, 1) <> "" Then
                    'si la pièce est prête
                    If .Cells(ligneRes, 17) = "" Then
                        With .Range("A" & ligneRes & ":Q" & ligneRes)
                            If .Cells(1, 9).Value = .Cells(1, 10).Value Then
                                .Interior.Color = RGB(192, 255, 128)   'ligne sans OF ni OA en vert
                            Else
                                .Interior.Color = RGB(255, 255, 0)   'gestion des reliquats en jaune
                                shSynthese.Range("K" & ligneRes & ":Q" & ligneRes).Merge
                                .Cells(1, 11).Value = "En attente de décision (confirmation des reliquats)"
                            End If
                            
                            .Font.Bold = True
                        End With
                    End If
                        
                    ligneRes = ligneRes + 1     'saut de ligne pour ne pas écraser l'ensemble vide
                End If
                For col = 1 To 10
                    .Cells(ligneRes, col).Value = shCommande.Cells(ligneCmd, col).Value
                Next col
                'bordure épaisse :
                .Range("A" & ligneRes & ":AG" & ligneRes).Borders(xlEdgeTop).Weight = xlThick
            End If
            
    
            If article <> "" Then
                'si le stock ne suffit pas
                stockTheo = CheckStocks(restants, articlesLus, article, shCommande.Cells(ligneCmd, 14).Value, shCommande.Cells(ligneCmd, 15).Value, CDate(shCommande.Cells(ligneCmd, 1).Value))
                If stockTheo < 0 Then
                    .Cells(ligneRes, 17).Value = stockTheo
                    Call CopyOF(projet, article, ligneRes, nbOF)
                    Call CopyOA(projet, article, ligneRes, nbOA)
    
                    If article <> lastArticle Or ensemble <> lastEnsemble Then
                        .Cells(ligneRes, 11) = article
                    End If
                    'quantités (à livrer, stock, en commande, en réserve
                    For col = 13 To 17
                        .Cells(ligneRes, col - 1).Value = shCommande.Cells(ligneCmd, col).Value
                    Next col
                    
                    If (nbOA > nbOF) Then nbOF = nbOA
                    If (nbOF > 0) Then
                        .Range("A" & ligneRes & ":Q" & ligneRes + nbOF - 1).Interior.Color = RGB(255, 255, 255)
                        ligneRes = ligneRes + nbOF
                    Else
                        With .Range("A" & ligneRes & ":Q" & ligneRes)
                            .Font.Color = RGB(255, 255, 255)
                            .Font.Bold = True
                            .Interior.Color = RGB(192, 0, 0)
                            .Interior.Pattern = xlPatternGray8
                        End With
                        ligneRes = ligneRes + 1
                    End If
                'sinon, le stock suffit
                Else
                                
                End If
            End If
            ligneCmd = ligneCmd + 1
        Wend
        
        If nbOF > 0 Then
        '    ligneRes = ligneRes - 1
        End If
        
        If ensemble = lastEnsemble And .Cells(ligneRes, 1) = "" Then
            ligneRes = ligneRes - 1
        Else
            'éventuellement la dernière ligne est un ensemble vide, auquel cas on la colore en vert
            If .Cells(ligneRes, 17) = "" Then
                With .Range("A" & ligneRes & ":Q" & ligneRes)
                    .Interior.Color = RGB(192, 255, 128)   'ligne sans OF ni OA en vert
                    .Font.Bold = True
                End With
            End If
        End If
        
        .Range("A2:AG" & ligneRes).Borders(xlInsideVertical).Weight = xlThin
    End With
    
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AG$" & ligneRes
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&""Arial,Gras""&14CARNET DE COMMANDES ET MANQUANTS" _
                        & " du " & shCommande.Range("C3").Value & " au " & shCommande.Range("C4").Value _
                        & Chr(10) & "Horizon des OF et OA: " & shOF.Range("C2").Value
                        
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = "Page &P de &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.354330708661417)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 70
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End Sub
Private Sub ResetForm(feuille As Worksheet)
    feuille.Range("A:IV").ClearContents
End Sub
Private Sub cmdReset_Click()
    If chkCC.Value = True Then Call ResetForm(shCC)
    If chkCommandes.Value = True Then Call ResetForm(shCommande)
    If chkOA.Value = True Then Call ResetForm(shOA)
    If chkOF.Value = True Then Call ResetForm(shOF)
    If chkOFMontage.Value = True Then Call ResetForm(shOFMontage)
End Sub

Private Sub cmdSyntheseDateClient_Click()

   'Suppression des commentaires AG 31:0:713
   Worksheets("Synthese").Columns("S:S").ClearComments
   
   
   'pour eviter de ralentir, on affiche les modifs seulement à la fin
    Application.ScreenUpdating = False
    
    Call CleanImports
    
    shCommande.Activate
    Rows("6:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("G6"), Order1:=xlAscending, _
                    Key2:=Range("E6"), Order2:=xlAscending, _
                    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, _
                    Key2:=Range("C6"), Order2:=xlAscending, _
                    Key3:=Range("B6"), Order3:=xlAscending, _
                    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    Call MakeSynthese
    
End Sub


Private Sub cmdSyntheseDateCommande_Click()
    

   'Suppression des commentaires AG 31:0:713
   Worksheets("Synthese").Columns("S:S").ClearComments
       
    
    'pour eviter de ralentir, on affiche les modifs seulement à la fin
    Application.ScreenUpdating = False
    
    Call CleanImports
    
    shCommande.Activate
    Rows("6:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, _
                    Key2:=Range("B6"), Order2:=xlAscending, _
                    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    Call MakeSynthese
End Sub


Private Sub MultiPage1_Change()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True
    
    If Height < 50 Then
        Height = 227
    Else
        Height = 5
    End If
End Sub

Sub AnnulerFusionCellules()
    Columns("A:AG").Select
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
fabien25000
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46 > Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
nos messages se sont croisés je n'avais pas vu le pâté de code..
c'est illisible sans les balises de code et sans la mise en forme des tabulations de rigueur je n'essayerai pas de déchiffrer personnellement

où est le lien de ton fichier?
fabien25000
Messages postés
589
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
26 juin 2019
46 -
ccm81 l'a précisé dans le post 2 à juste titre puisque je n'en avais pas parlé (merci à lui)

pour joindre ton fichier
1) Tu vas dans https://mon-partage.fr/
2) Tu cliques sur [Choisir un fichier] pour sélectionner ton fichier
3) Tu Clic sur [Uploader], un lien va s'afficher que tu copies
4) Tu reviens dans ta discussion sur CCM, et dans ton message tu fais "Coller".
Commenter la réponse de fabien25000
Messages postés
9163
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
17 octobre 2019
1651
0
Merci
Bonjour

Pour compléter la réponse de fabien25000, pour joindre un fichier, utilises https://mon-partage.fr/ et joins le lien obtenu à ton prochain message

Cdlmnt
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
voilà c'est fait
Merci ccm81 :) !
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
Bonjour,

voilà le lien https://mon-partage.fr/f/VT3ldTO8/

Merci et prière de m'aider svp!
Commenter la réponse de ccm81