Opérations périodiques

FRANCK33 à dit:

J'ai élaboré un programme de gestion de comptes qui fonctionne très bien.

Cliquez pour agrandir...

FRANCK33 à dit:

...Malheureusement rien ne fonctionne dans mon fichier original...

Cliquez pour agrandir...

FRANCK33 à dit:

...Je souhaiterai que le 11 de chaque mois cette ligne apparaisse sur ma feuille sans mon intervention, mais est-ce possible ?...

Cliquez pour agrandir...

• Les échéances sont décrites sur la même feuille et dans le même tableau des dépenses et recettes (Rec-Dep).
• Quand un évènement change se produit sur la feuille, la calculette que j'ai dérobée à DoubleZero (et qui me pardonnera peut-être ? 😱) apparaît. Ce qui signifie qu'une actualisation est utile -> cliquer sur la calculette pour actualiser (après les nouvelles saisies)

• elle trie les lignes en fonctions de la date (en embarquant les échéances échues ou non)
• puis repère la 1ière date supérieure à la date du jour ou vide.
• puis trie les lignes (sup. à la date du jour) en fonction de leur libellé et ensuite de leur date
• puis insère des lignes pour les prochaines saisies manuelles
• puis complète la colonne F par la formule qui va bien.

• si on clique sur la calculette
• à l'ouverture du classeur
• à l'activation de la feuille Rec-Dep

Option Explicit

Sub CalculMiseEnForme()
Dim xrg As Range, xcell As Range

Application.ScreenUpdating = False
With Sheets("Rec-Dep")
  'tri complet
  Set xrg = .Cells(.Rows.Count, "a").End(xlUp)
  Set xrg = .Range(.Cells(3, "a"), .Cells(xrg.Row, "f"))
  xrg.Sort .Cells(1, "a"), Header:=xlNo
  
  'recherche parmi les dates du lendemain ou vide
  Set xrg = .Cells(.Rows.Count, "a").End(xlUp)
  Set xrg = .Range(.Cells(3, "a"), xrg)
  For Each xcell In xrg
    If Len(xcell) = 0 Then Exit For
    If xcell.Value2 > CLng(Date) Then Exit For
  Next xcell
  
  'tri selon libellé puis date des échéances (non échues)
  Set xrg = .Range(xcell, .Cells(.Range("a" & Rows.Count).End(xlUp).Row, "f"))
  xrg.Sort key1:=xcell(1, 3), key2:=xcell, Header:=xlNo
  
  'On fait de la place pour les nouvelles écritures
  xcell.Resize(15, 6).Insert shift:=xlShiftDown, copyorigin:=xlFormatFromLeftOrAbove
  
  'Application de la formule en colonne F
  Set xrg = .Cells(.Rows.Count, "a").End(xlUp)
  Set xrg = .Range(.Cells(3, "f"), .Cells(xrg.Row, "f"))
  xrg.FormulaR1C1 = _
    "=IF(RC[-5]>TODAY(),"""",IF(AND(RC[-2]=0,RC[-1]=0),"""",R[-1]C-RC[-2]+RC[-1]))"
    
  ' on masque la calculette
  .Shapes.Range(Array("00_Bouton")).Visible = False
  
  'on se place sur la première cellule de saisie
  .Activate
  xcell.Offset(-15).Select
End With
Application.ScreenUpdating = True
End Sub

mapomme à dit:

... la calculette que j'ai dérobée à DoubleZero (et qui me pardonnera peut-être ? 😱)...

Cliquez pour agrandir...

FRANCK33 à dit:

...J'avoue que je ne maîtrise pas vraiment...

Cliquez pour agrandir...

• effacez les données du tableau de la feuille "Rec-Dep"
• collez-y par valeur les valeurs de votre propre tableau.
• collez-y par valeur l'échéancier de vos prélèvements périodiques (passez la couleur de police en rouge pour les distinguer)
• copiez la feuille "Récap" de votre classeur vers mon classeur.
• Il sera nécessaire d'adapter les formules de cette feuille "Récap" car dans mon classeur "Feuil1" s'appelle "Rec-Dep"