Formule de rapproche pour Comptabilité


#1

Bonjour
Je recherche une formule que je pourrais appliquer sur les onglets des comptes du plan comptable lorsque j’écris sur celui de l’onglet 51201.

Exemple sur l’onglet 51201, lorsque je rempli une ligne avec dans la colonne “compte” ==> 604, que l’intégralité de la ligne s’inscrive dans l’onglet 604 sauf le libellé qui sera modifié manuellement.

Ci joint un fichier modèle
Merci de votre aideLivre comptable.xlsx (76,4 Ko)


#2

Bonjour,

La réalisation est possible en VBA, mais un soucis avec deux onglets
Onglet 530 :
Les Débit et Crédit sont en colonne E & F contrairement au autres sur F & G (moindre soucis en ajoutant une colonne masquée)

Onglet 625 :
Celui-ci, regroupe 4 compte différents sur sa largeur. Savoir sur quel compte doit se placer les données ? :thinking:

Sinon, c’est presque réalisé :wink:


#3

Bonjour et merci de ton aide
Pour le 625 je crée au pire des onglets différents 6251… 6252 etc et pour le 530, on gère très peu d’espèce donc si c’est le seul que je dois faire manuellement c’est pas un soucis.


#4

Re,

Ok, dans ce cas les données iront dans le premier tableau et pour l’autre (le 530) je rajoute une colonne masquée


#5

Re,

Bon voici une approche (Normalement, il ne devrait pas y avoir de soucis, au cas où, me le dire)

Les MACROS en MODULE

Option Explicit
Dim Sh As Shape
Dim SelectionLigne%, C%, Livre$, Dl%                              'Déclaration des variables

Sub DeleteShapes() 'sur une feuille
C = ActiveCell.Row                                                'N° de la ligne de la cellule active
  If Feuil1.Range("C" & C).Value = "" Then                        'Si la cellule de la colonne C est vide, Message et se rend à la Fin
    MsgBox "Vous n'avez pas renseigné le N° de compte", vbInformation, "Saisie manquante"
    GoTo Fin
  End If
  On Error Resume Next                                            'Gestion erreur si le N° de compte n'existe pas, se rend à la Fin
  If Feuil1.Range("E" & C).Value <> "" Or _
    Feuil1.Range("F" & C).Value <> "" Then                        'S'il y a un montant colonne E ou F
    Livre = Range("C" & C).Text                                   'Variable Livre prend le nom de la feuille
    Dl = Sheets(Livre).Range("A5").End(xlDown).Row + 1            'Recherche la 1ère ligne vide de la feuille
    Feuil1.Range(Cells(C, "A"), Cells(C, "B")).Copy               'Copie les données en valeur
    Sheets(Livre).Range("A" & Dl).PasteSpecial (xlPasteValues)
    Feuil1.Range(Cells(C, "E"), Cells(C, "F")).Copy
    Sheets(Livre).Range("F" & Dl).PasteSpecial (xlPasteValues)
    Feuil1.Activate                                               'Active la feuille principale
    Application.CutCopyMode = False                               'Déactive la sélection
  Else                                                            'Sinon si les colonnes E ou F sont vides, msg erreur
    If Feuil1.Range("E" & C).Value = "" Or Feuil1.Range("F" & C).Value = "" Then
      MsgBox "Vous n'avez aucun montant de renseigné en Débit ou Crédit", vbInformation, "Saisie manquante"
    End If
    For Each Sh In Feuil1.Shapes                                  'Supprime le Bouton
      Sh.Delete
    Next Sh
    Exit Sub
  End If
  On Error GoTo 0
Fin:
  For Each Sh In Feuil1.Shapes
    Sh.Delete
  Next Sh
End Sub

Sub AjoutBouton()
  Set Sh = Feuil1.Shapes.AddFormControl(xlButtonControl, 528, 100, 122, 16) 'Ajoute un Bouton
  Set Sh = Feuil1.Shapes(1)
  SelectionLigne = ActiveCell.Row                        'On récupère le N° de la ligne
  Sh.Left = Feuil1.Range("G" & SelectionLigne).Left      'Le positionne à gauche cellule active
  Sh.Top = Feuil1.Range("G" & SelectionLigne).Top        'Le positionne en haut cellule active
  Sh.Width = Range("G7:H7").Width                        'Le positionne sur deux cellule depuis cellule active
  Sh.Height = Range("G7:H7").Height
  Sh.TextFrame.Characters.Text = "Transfert"             'Nomme le bouton
  'Sur action du bouton, envoi la macro pour supprimer les shapes de la feuille en module DeleteShapes
  Sh.OnAction = "DeleteShapes"
End Sub

La MACRO FEUILLE:

Option Explicit
'Si on active une des cellules des colonnes E ou F de la ligne 7 à 47
Private Sub Worksheet_selectionChange(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("E7:E47,F7:F47")) Is Nothing Then
    AjoutBouton  'Lance la procèdure Ajout Bouton
  End If
End Sub

Le CLASSEUR:
Livre comptable.xlsm (91,1 Ko)


#6

Merci pour je vais tester cela et je reviens vers toi. En tout cas, encore merci pour ton aide si précieuse