Problème lie a exécution du marco

j’ai une problème lorsque j’exécute du macro, la fenêtre clignote,

Bonjour Enos,

Comment veux-tu que l’on t’aide avec aussi peu d’explications !?.. Fait un effort et tu seras récompensé.

ci-joint le marco
Sub crea_decharge()

’ crea_decharge Macro


ActiveWindow.SmallScroll Down:=-15
Sheets(« JOURNAL »).Select
Range(« F8 »).Select
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Rows(« 5:5 »).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(« B5:J5 »).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range(« C5 »).Select
ActiveCell.FormulaR1C1 = _
« =(IF(RC[1]=0, »""",("« F-AD/N° «  »&TEXT(MID(R[1]C,9,3)+1, »« 000" »)&""-""&TEXT(RC[1],"« AAAA.mm. »"))))"
Range(« B5 »).Select
ActiveCell.FormulaR1C1 = « =IF(RC[1]=0, »""",R[1]C+1)"
Range(« B5 »).Select
ActiveCell.FormulaR1C1 = « =IF(RC[2]=0, »""",R[1]C+1)"
Range(« D5 »).Select
ActiveCell.FormulaR1C1 = «  »
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« C10:D10 »).Select
Selection.Copy
Application.CutCopyMode = False
Range(« C10:D10 »).Select
Selection.Copy
Sheets(« JOURNAL »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« C5 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« G9 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« E12:I12 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« E5 »).Select
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« E12:I12 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« E5 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« E12 »).Select
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« E22:G22 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« F5 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« F11 »).Select
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« D24:E24 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« G5 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(« DECHARGE DE REGLEMENT »).Select
ActiveWindow.SmallScroll Down:=9
Range(« E26:F26 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« H5 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« F12 »).Select
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« D28:E28 »).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« JOURNAL »).Select
Range(« I5 »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« I5 »).Select
Application.CutCopyMode = False
Selection.NumberFormat = « m/d/yyyy »
Range(« J5 »).Select
Sheets(« DECHARGE DE REGLEMENT »).Select
Range(« E18:F18 »).Select
Selection.Copy
Sheets(« JOURNAL »).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(« J5 »).Select
Application.CutCopyMode = False
Selection.Style = « Comma »
Range(« I8 »).Select
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Sheets(« IMPRESSION »).Select
ActiveWindow.SmallScroll Down:=36
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
IgnorePrintAreas:=False
Sheets(« DECHARGE DE REGLEMENT »).Select
ActiveWindow.SmallScroll Down:=-9
Range(« C10:D10 »).Select
Selection.ClearContents
Range(« E12:I12 »).Select
Selection.ClearContents
Range(« C14:D14 »).Select
Selection.ClearContents
Range(« F14 »).Select
Selection.ClearContents
Range(« D16:I16 »).Select
Selection.ClearContents
Range(« E18:F18 »).Select
Selection.ClearContents
Range(« E22:G22 »).Select
Selection.ClearContents
Range(« D24:E24 »).Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=6
Range(« E26:F26 »).Select
Selection.ClearContents
Range(« D28:E28 »).Select
Selection.ClearContents
Range(« G28:H28 »).Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-18
Range(« G9 »).Select
Selection.ClearContents
ActiveWorkbook.Save
End Sub

Re,

Un code sans le fichier ne nous aide pas. Surtout tel qu’il est formaté. Puisque tu n’es même pas capable de fournir un fichier je passe la main. Bonne chance…

DECHARGE.xlsm (71,7 Ko)

Bonjour Enos, bonjour le forum,

Plusieurs points :

• La règle d’or en VBA c’est d’éviter autant que possible les Select ou autres Activate. Ils ne font que ralentir l’exécution du code et sont source de nombreux bug. Quand on travaille sur plusieurs onglets, la syntaxe pour un copier/coller est :
OngletSource.PageSource.Copy OngletDestination.CelluleDestination
Par exemple, pour copier la plage A1:A10 de l’onglet Feuil1 et la coller dans A1 de l’onglet Feuil2, il suffira d’écrire :
Worksheets(« Feuil1 »).Range(« A1:A10 »).Copy Worksheets(« Feuil2 »).Range(« A1 »)
Tu vois, aucun Select ! On ne navigue pas entre les onglets. Ce ce qui faisait clignoter la fenêtre…

• Pour éviter ça, il suffit d’écrire :
Application.ScreeUpdating = False
Au début du code. Il n’est d’ailleurs même pas obligatoire de remettre à :
Application.ScreenUpdating = True
ça se remet tout seul à la fin de la macro.

• L’utilisation d’un tableau structuré t’évite d’avoir a recopier les formats et ou formules des lignes au-dessus. Cela se fait automatiquement. C’est pour cela que j’ai transformé le tableau de l’onglet Journal en tableau structuré.

• L’utilisation de cellules fusionnées n’est pas une bonne idée si tu dois coder en VBA derrière. À éviter…

• Les macros s’écrivent, en principe, de préférence dans un module standard et pas dans un composant Sheet. Même si dans ton cas c’est le bouton VALIDATION qui l’exécution du code…

Ceci dit, Voilà ton code modifié, J’ai supprimé les deux formules qu’il y avait et tout écris en dur dans le code :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Décharge de Règlement)
Dim OJ As Worksheet 'déclare la variable OJ (Onglet Journal)
Dim OI As Worksheet 'déclare la variable OI (Onglet Impression)
Dim TJ As ListObject 'déclare la variable TJ (Tableau structuré Journal)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim D As Date 'déclare la variable D (Date)
Dim N As Integer 'déclare la variable N (Numéro)

Set OD = Worksheets("DECHARGE DE REGLEMENT") 'définit l'onglet OD
Set OJ = Worksheets("JOURNAL") 'définit l'onglet OJ
Set OI = Worksheets("IMPRESSION") 'définit l'onglet OI
D = OD.Range("C10:D10")(1, 1) 'définit la date D
Set TJ = OJ.ListObjects(1) 'définit le tableau structuré TJ (le journal)
Set R = TJ.ListColumns(3).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 3 de TJ)
If R Is Nothing Or TJ.ListRows Is Nothing Then 'condition : si aucune occurrence n'est trouvée ou si TJ n'a pas de ligne
    TJ.ListRows.Add 'ajoute une ligne au tableau structuré TJ
    LI = TJ.ListRows.Count 'définit la ligne LI (dernière ligne de TJ)
Else 'sinon (au moins une occurrence est trouvée)
    LI = R.Row - TJ.HeaderRowRange.Row 'définit la ligne LI de la première occurrence trouvé - la ligne des en-tête de TJ
End If 'fin de la condition
N = Application.WorksheetFunction.Max(TJ.ListColumns(1).Range) + 1
'numérotation automatique dans la cellule ligne LI colonne 1 de TJ
TJ.DataBodyRange(LI, 1) = N
'Numéro de référence dans la ligne LI colonne 2 de TJ
TJ.DataBodyRange(LI, 2) = "F-AD/Nº " & Format(N, "000") & "-" & Year(D) & "." & Format(Month(D), "00") & "."
'récupère dans la ligne LI colonne 3 de TJ la valeur de la plage C10:D10 de l'onglet OD (la date D)
TJ.DataBodyRange(LI, 3).Value = D
'renvoiela référence dans la cellule G9 de l'onglet OD
OD.Range("G9").Value = TJ.DataBodyRange(LI, 2).Value
'récupère dans la ligne LI colonne 4 de TJ la valeur de la plage E12:I12 de l'onglet OD (le bénéficiaure)
TJ.DataBodyRange(LI, 4).Value = OD.Range("E12:I12")(1, 1).Value
'récupère dans la ligne LI colonne 5 de TJ la valeur de la plage E22:G22 de l'onglet OD (le motif de paiment)
TJ.DataBodyRange(LI, 5).Value = OD.Range("E22:G22")(1, 1).Value
'récupère dans la ligne LI colonne 6 de TJ la valeur de la plage D24:E24 de l'onglet OD (la pièce d'identité)
TJ.DataBodyRange(LI, 6).Value = OD.Range("D24:E24")(1, 1).Value
'récupère dans la ligne LI colonne 7 de TJ la valeur de la plage E26:F26 de l'onglet OD (le numéro de la pièce d'identité)
TJ.DataBodyRange(LI, 7).Value = OD.Range("E26:F26")(1, 1).Value
'récupère dans la ligne LI colonne 8 de TJ la valeur de la plage D28:E28 de l'onglet OD (délivré le)
TJ.DataBodyRange(LI, 8).Value = OD.Range("D28:E28")(1, 1).Value
'récupère dans la ligne LI colonne 9 de TJ la valeur de la plage E18:F18 de l'onglet OD (le  montant en chiffre)
TJ.DataBodyRange(LI, 9).Value = OD.Range("E18:F18")(1, 1).Value
TJ.DataBodyRange(LI, 9).Style = "Comma" 'syle "Comma" dans la celllule ligne LI colonne 8 de TJ (?)
OI.Activate 'avtive l'onglet OI
'imprime deux exemplaires
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
    IgnorePrintAreas:=False

'Efface les anciennes données de l'onglet OD
OD.Range("C10:D10")(1, 1).Value = ""
OD.Range("E12:I12")(1, 1).Value = ""
OD.Range("C14:D14")(1, 1).Value = ""
OD.Range("F14").Value = ""
OD.Range("D16:I16")(1, 1).Value = ""
OD.Range("E18:F18")(1, 1).Value = ""
OD.Range("E22:G22")(1, 1).Value = ""
OD.Range("D24:E24")(1, 1).Value = ""
OD.Range("E26:F26")(1, 1).Value = ""
OD.Range("D28:E28")(1, 1).Value = ""
OD.Range("G28:H28")(1, 1).Value = ""
OD.Range("G9").Value = ""
ThisWorkbook.Save 'save le classeur qui contient cette macro
End Sub

Enos_FE_v01.xlsm (47,8 Ko)

merci robert en vrai la cacahouète n’est pas aussi petite que sur la photo profil :wink:

ben tant t’es la autant en profités, j’ai une formule que le veut insérer dans le Marco
ou la convertir en marco
la formule
=SI(E6="";"";SI(ET(J6="";K6="");« instance paiement »;SI([@reliquat]<0;« instance paiement »;SI(L6=« facture »;« SOLDE »;SI(L6=« déclaration »;« solde »;SI(L6=« police d’assurance »;« solde »;SI(L6=« note d’honoraire »;« solde »;SI(L6=« quittance »;« solde »;« fact. attente »))))))))
pour un tableau structures

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.