Microsoft 365 [VBA] Macro pour automatiser une sortie

asso78Lim · 14 Mai 2022

Bonjour à toutes et à tous,
Tout d'abord je tenais à remercier les intervenants du forum pour leurs implications et les solutions mise à disposition de tous !

J'ai un problème que je n'arrive pas à résoudre malgré plusieurs tentatives et moultes recherches, mes compétences en VBA sont très limités mais la plupart du temps j'arrive à m'en sortir à l'aide du forum (encore merci!).

J'ai un tableau qui recense toutes les dépenses liées à mon petit commerce et qui s'actualise à chaque nouvel achat.
Pour chaque produit j'ai un budget à ne pas dépasser lors de mes commandes que je modifie en fonction de mes besoins chaque mois.
Les achats réalisés sont inscris manuellement sur un autre tableau à l'aide d'un userform.
Travaillant avec des personnes d'un certain âge qui n'arrive pas toujours à utiliser excel, j'aimerais automatiser cette action pour éviter des erreurs et limiter le stress que ça peut représenter par "peur de mal faire".

Voici mon problème,
Dans le fichier excel joint il y'a 3 feuilles : "Achat", "Budget", "Résumé"

J'aimerais qu'en cliquant sur un bouton :

-Les références présentes dans la feuille budget se mette automatiquement à jour (en les soustrayant) en fonction des références présentes sur la feuille "Achat"

-Dans la feuille "Résumé", j'essaye (mais en vain) de retranscrire les achats réalisés à la suite avec les informations de la référence (qui se trouve dans la feuille "Budget"), le montant de la commande et le budget final après la commande.
(J'ai fais un exemple sur le fichier joint, c'est plus compréhensible qu'une explication hasardeuse)

-Si lors d'un clic l'un des budgets devient négatif prévenir l'utilisateur.

Pour le premier point j'ai réussi à bidouiller quelque chose mais avec un code incompréhensible, j'ai l'espoir que quelqu'un pourra me proposer un code plus simple.
Pour le deuxième point j'ai essayé de nombreux code mais je ne comprend pas toutes les subtilités et il est pour moi impossible de réaliser ça tout seul.

Merci à vous d'avoir pris le temps de me lire (c'était long désolé) et je remercie d'avance les intervenants qui prendront le temps de me répondre si solution il existe.
En vous souhaitant une excellente journée,

Asso

soan · 17 Mai 2022

Bonjour Asso, Staple1600,

nouveau fichier, avec la simplification proposée par Staple.

VB:

Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub 'sortir de la sub si référence non trouvée
    dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5): ect = .Cells(cel.Row, 6)
  End With
  With Worksheets("Résumé").Cells(j, 2)
    .Value = Date
    .Offset(, 1) = StrConv(Format(Date, "dddd"), 3) 'jour de la semaine
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf...

soan · 16 Mai 2022

Re,

cette version est très légèrement différente ; comme finalement j'ai mis une MFC pour bien voir tous les budgets négatifs, j'ai pensé que la boîte de dialogue (avertissement) pour montrer ces budgets négatifs est devenue inutile ; j'ai donc enlevé du code tout ce qui y a trait ; les manips sont simplifiées vu que la boîte de dialogue ne s'affiche plus, et que ça t'évite de cliquer sur son bouton OK pour la quitter : tu peux aller directement sur la feuille "Résumé" (donc à part ça, le mode d'emploi est le même qu'avant).

nouveau code VBA :

VB:

Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub 'sortir de la sub si référence non trouvée
    dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5): ect = .Cells(cel.Row, 6)
  End With
  With Worksheets("Résumé").Cells(j, 2)
    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", _
      "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf      'Référence
    .Offset(, 5) = dsg      'Désignation
    .Offset(, 6) = T(i, 2)  'Montant commande (idem que Achat)
    .Offset(, 7) = ect      'Écart autorisé ("oui" ou "non")
    .Offset(, 8) = bdg      'Budget final
  End With
End Sub

Private Sub Bouton_Click()
  Dim cel As Range, bdg&, n&, i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[E5].Resize(n, 2)
  End With
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5): bdg = .Value - T(i, 2): .Value = bdg: End With
      End If
    Next i
  End With
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 3, 1: j = 3
    Else
      .ListRows.Add: j = .ListRows.Count + 2: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
     For i = 2 To n
       .ListRows.Add: j = j + 1: WriteLig j, i
     Next i
  End With
  Worksheets("Budget").Select
End Sub

dis-moi quelle est la version que tu préfères : avec ou sans boîte de dialogue ; et c'est cette version-là dont je commenterai le code VBA ; au cas où tu préfères sans MFC, il faudra juste enlever une règle de MFC dans la version que tu auras choisie ; c'est très simple à faire, et le code VBA n'a pas besoin d'être modifié : c'est indépendant de la MFC, donc il reste identique.

soan

asso78Lim · 16 Mai 2022

Coucou @soan tu me régales !!!!
Pour la MFC c'est parfait c'est encore mieux, est-il possible de rajouter une MFC pour la feuille "Budget" qui mettrait en rouge la case quand elle est à 0 aussi ? Mais uniquement pour la feuille budget pas pour la feuille "Résumé".
Sinon c'est a deuxième version que je préfère c'est vraiment parfait je te remercie énormément pour le temps que tu as passé à m'aider vraiment MERCI !

soan · 16 Mai 2022

ok, donc va pour la 2ème version : sans boîte de dialogue ; pour les MFC :

* feuille "Budget" : j'ai modifié la règle de MFC : c'est en rouge pour 0 aussi (pas besoin d'ajouter une autre règle) : le test est "<= 0" au lieu de "< 0". (y'a pas d'exemple où le budget alloué est à 0, mais y'en a dans ton vrai fichier ! )

* feuille "Résumé" : j'ai supprimé la règle de MFC ➯ pas de rouge sur le tableau de cette feuille.

les manips sont identiques ; le code VBA est inchangé ; je t'ai écrit un MP.

soan

soan · 16 Mai 2022

Bonjour Asso,

voici les commentaires du code VBA :

Option Explicit : ça oblige à déclarer les variables.

Dim T : variable sans type T ; servira pour contenir les données de Tableau1 (feuille "Achat") ; la variable est globale car T doit être visible (accessible) à la fois par la sub WriteLig() et par la sub Bouton_Click().

Private Sub WriteLig(j&, i&) .. End Sub : le but de cette sub est d'écrire une ligne de Tableau3 (feuille "Résumé") ; on transmet j qui est le n° de ligne où on écrit dans Tableau3 ; on transmet aussi i qui est le n° de ligne qu'on lit dans la variable T (c'est donc pour une ligne Référence / Achat).

Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3 : déclaration de différentes variables ; pour les types : Dim réf$ : idem que Dim réf As String ; Dim bdg& : idem que Dim bdg As Long ; Dim ect As String * 3 : ect est une chaîne de 3 caractères.

réf = T(i, 1) : la référence est la donnée de la ligne i, 1ère colonne de T ; donc pour i=1, c'est le 1 de E5.

dsg = "?" : dsg est la désignation ; au départ : "?" ; si on ne trouvera pas de désignation, c'est "?" qui sera affiché (c'est une valeur par défaut) ; car si plus tard on va trouver la désignation, elle remplacera "?".

With Worksheets("Budget") .. End With : avec la feuille "Budget"

Set cel = .Columns(2).Find(réf, , -4163, 1, 1) ; -4163 : idem que xlValues ; 1er 1 : idem que xlWhole ; 2ème 1 : idem que xlByRows ; on cherche la référence en colonne 2 (= colonne B) de la feuille "Budget".

If cel Is Nothing Then Exit Sub : si la référence n'est pas trouvée, on sort de la sub ➯ la suite de la sub est exécutée seulement si on trouve la référence en colonne B.

si on a trouvé la référence en colonne B, la cellule correspondante est cel ; et cel.Row est la ligne de cette cellule ; cel.Row est donc la ligne de la référence trouvée ; on va pouvoir lire, sur la même ligne, 3 données correspondantes.

dsg = .Cells(cel.Row, 3) : désignation, en colonne 3 (colonne C) ; c'est ici que le "?" initial de dsg est remplacé (vu qu'on a bien trouvé la référence).

bdg = .Cells(cel.Row, 5) : budget alloué, en colonne 5 (colonne E).

ect = .Cells(cel.Row, 6) : écart autorisé, en colonne 6 (colonne F).

With Worksheets("Résumé").Cells(j, 2) .. End With : avec la cellule de la feuille "Résumé" qui est en colonne 2 (= colonne B), ligne j ; rappel : j est le n° de ligne où on écrit dans Tableau3 (1er paramètre transmis à la sub) ; comme on a le bon n° de ligne, on peut écrire sur la même ligne toutes les infos nécessaires :

VB:

    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", _
      "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf      'Référence
    .Offset(, 5) = dsg      'Désignation
    .Offset(, 6) = T(i, 2)  'Montant commande (idem que Achat)
    .Offset(, 7) = ect      'Écart autorisé ("oui" ou "non")
    .Offset(, 8) = bdg      'Budget final

ci-dessus : .Value est la cellule du With, donc en colonne 2 (B ; Date) ; .Offset(, 1) est 1 colonne à droite (C ; jour de la semaine) ; .Offset(, 2) est 2 colonnes à droite (D ; "Achat") ; etc... : de 3 à 8 = colonnes E à J.

la suite sera dans un prochain post.

soan

Staple1600 · 17 Mai 2022

Bonsoir le fil

Si je puis me permettre

Code:

Sub Complication()
MsgBox Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
End Sub
Sub Simplication()
MsgBox StrConv(Format(Date, "dddd"), 3)
End Sub

Et sinon pour rappel

Majuscules aux noms de jours et de mois | Académie française

Les noms des jours et des mois sont des noms communs qui forment une catégorie extrêmement limitée, et qui le serait encore quand bien même on y ajouterait les noms des jours et des mois révolutionnaires, comme quintidi ou décadi,...

www.academie-francaise.fr

Reste à savoir si le début d'une cellule vaut le début d'une phrase

C'est sur cette question que je vais aller me coucher

soan · 17 Mai 2022

Bonjour Asso, Staple1600,

nouveau fichier, avec la simplification proposée par Staple.

VB:

Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub 'sortir de la sub si référence non trouvée
    dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5): ect = .Cells(cel.Row, 6)
  End With
  With Worksheets("Résumé").Cells(j, 2)
    .Value = Date
    .Offset(, 1) = StrConv(Format(Date, "dddd"), 3) 'jour de la semaine
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf      'Référence
    .Offset(, 5) = dsg      'Désignation
    .Offset(, 6) = T(i, 2)  'Montant commande (idem que Achat)
    .Offset(, 7) = ect      'Écart autorisé ("oui" ou "non")
    .Offset(, 8) = bdg      'Budget final
  End With
End Sub

Private Sub Bouton_Click()
  Dim cel As Range, n&, i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[E5].Resize(n, 2)
  End With
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5): .Value = .Value - T(i, 2): End With
      End If
    Next i
  End With
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 3, 1: j = 3
    Else
      .ListRows.Add: j = .ListRows.Count + 2: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
    For i = 2 To n
      .ListRows.Add: j = j + 1: WriteLig j, i
    Next i
  End With
  Worksheets("Budget").Select
End Sub

soan

soan · 17 Mai 2022

@Asso

la 1ère partie des commentaires du code VBA est dans mon post #34 ; lis aussi les 2 posts #35 et #36 ; voici la seconde partie des commentaires du code VBA.

Private Sub Bouton_Click() .. End Sub : c'est la sub du Bouton de la feuille "Achat".

Dim cel As Range, n&, i&, j& : déclaration de différentes variables ; rappel : & = Long.

Application.ScreenUpdating = 0 : gel de la mise à jour de l'écran ➯ exécution plus rapide.

With Worksheets("Achat") .. End With : avec la feuille "Achat" (c'est l'ancienne sub ReadAchats)

With .ListObjects("Tableau1") .. End With : avec Tableau1 de "Achat".

If .DataBodyRange Is Nothing Then Exit Sub : on sort de la sub si le tableau est vide.

n = .ListRows.Count : n est le nombre de lignes du tableau.

T = .[E5].Resize(n, 2) : E5 est étendu à n lignes, 2 colonnes ; on met les données de Tableau1 (plage E5:F9 pour ton fichier exemple) dans la variable T.

With Worksheets("Budget") .. End With : avec la feuille "Budget".

For i = 1 To n .. Next i : pour toutes les lignes de T (donc pour toutes les lignes Référence / Achat).

Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1) ; -4163 : idem que xlValues ; 1er 1 : idem que xlWhole ; 2ème 1 : idem que xlByRows ; on cherche T(i,1) (donc la Référence) en colonne 2 (= colonne B) de la feuille "Budget".

If Not cel Is Nothing Then .. End If : si la référence est trouvée, on exécute la ligne qui est dans le corps du If.

With .Cells(cel.Row, 5) .. End With ; cel.Row est la ligne de la référence trouvée ; avec la cellule de cette ligne, colonne 5 (colonne E).

.Value = .Value - T(i, 2) : la valeur de la cellule du With (donc le budget alloué initial) est diminuée de T(i,2) (le montant de l'Achat qui correspond à la Référence, selon Tableau1 de la feuille "Achat" qui a été lu dans la variable T).

With Worksheets("Résumé").ListObjects("Tableau3") .. End With : avec Tableau3 de la feuille "Résumé".

VB:

    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 3, 1: j = 3
    Else
      .ListRows.Add: j = .ListRows.Count + 2: WriteLig j, 1
    End If

pour la 1ère référence :

si Tableau3 est vide, on utilise la ligne n° 3, sinon on utilise la ligne .ListRows.Count + 2 (valeur de j) ; rappel : le 2ème paramètre de WriteLig() est la valeur qui va dans i : c'est 1 pour la 1ère référence.

VB:

    'pour les autres références de la feuille "Achat"
    For i = 2 To n
      .ListRows.Add: j = j + 1: WriteLig j, i
    Next i

des références 2 à n, on transmet i en 2ème paramètre (donc 2 à n) ; j est augmenté de 1, donc une ligne plus bas quand on écrit dans Tableau3.

Worksheets("Budget").Select : on va sur la feuille "Budget".

soan

asso78Lim · 18 Mai 2022

Bonjour à vous deux,

Premier jour de travail avec le nouveau fichier et c'est déjà superbe !!!!
Merci pour vos interventions!

Je vais commencer à me plonger dans le commentaire de ce code pour en comprendre les rouages Encore une fois un grand merci à @soan pour cette proposition !

Microsoft 365 [VBA] Macro pour automatiser une sortie

asso78Lim

XLDnaute Nouveau

Pièces jointes

soan

soan

XLDnaute Barbatruc

Pièces jointes

asso78Lim

XLDnaute Nouveau

soan

XLDnaute Barbatruc

Pièces jointes

soan

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Majuscules aux noms de jours et de mois | Académie française

soan

XLDnaute Barbatruc

Pièces jointes

soan

XLDnaute Barbatruc

asso78Lim

XLDnaute Nouveau

Discussions similaires