Débogage Macro: Absence de commande
Résolu/Fermé
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
-
Modifié le 3 juin 2019 à 12:03
Mirguy23 Messages postés 42 Date d'inscription lundi 27 mai 2019 Statut Membre Dernière intervention 30 juillet 2019 - 11 juin 2019 à 08:59
Mirguy23 Messages postés 42 Date d'inscription lundi 27 mai 2019 Statut Membre Dernière intervention 30 juillet 2019 - 11 juin 2019 à 08:59
A voir également:
- Débogage Macro: Absence de commande
- Message d'absence outlook - Guide
- Invite de commande - Guide
- Message d'absence thunderbird - Guide
- Macro logiciel - Télécharger - Organisation
- Commande en attente d'acceptation fnac ✓ - Forum Consommation et internet
3 réponses
fabien25000
Messages postés
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
5 juin 2019 à 15:50
5 juin 2019 à 15:50
la première chose que je vois c'est que tu utilises plusieurs fois
sinon un détail sur la durée du workbook open, tu peux remplacer ça
par ça
c'est infiniment plus rapide
vérifie déjà si notre histoire de
Application.ScreenUpdating = Falsemais 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 = Truene 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
fabien25000
Messages postés
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
3 juin 2019 à 18:18
3 juin 2019 à 18:18
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
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
Modifié le 4 juin 2019 à 08:46
Modifié le 4 juin 2019 à 08:46
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... :(
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
Modifié le 11 juin 2019 à 16:53
Modifié le 11 juin 2019 à 16:53
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
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
>
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
4 juin 2019 à 17:32
4 juin 2019 à 17:32
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?
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
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
Modifié le 4 juin 2019 à 08:55
Modifié le 4 juin 2019 à 08:55
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".
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".
ccm81
Messages postés
10544
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
18 mars 2023
2 336
3 juin 2019 à 22:55
3 juin 2019 à 22:55
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
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
4 juin 2019 à 08:54
4 juin 2019 à 08:54
voilà c'est fait
Merci ccm81 :) !
Merci ccm81 :) !
Mirguy23
Messages postés
42
Date d'inscription
lundi 27 mai 2019
Statut
Membre
Dernière intervention
30 juillet 2019
5 juin 2019 à 14:50
5 juin 2019 à 14:50
Bonjour,
voilà le lien https://mon-partage.fr/f/VT3ldTO8/
Merci et prière de m'aider svp!
voilà le lien https://mon-partage.fr/f/VT3ldTO8/
Merci et prière de m'aider svp!
11 juin 2019 à 08:59
après vérification il y a bel et bien un problème sur < Application.ScreenUpdating = True >