Résultat d'une formule dans commentaire par macro

Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Bonjour à tous,

J'ai récupéré sur le forum une macro qui permet d'insérer des commentaires automatiques à partir de formules et je me suis empressé de vouloir l'adapter à mon fichier.
Seulement voilà je n'arrive pas à modifier cette macro pour qu'elle m'affiche le montant réalisé qui se trouve dans un autre classeur.

J'espère que l'un d'entre vous pourra me dépanner et je l'en remercie par avance.

La macro que j'ai insérée dans mon fichier "Suivi consommation" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range

For Each Cell In Range("G5:R5")
Cell.ClearComments
Next

If Not Application.Intersect(Target, Range("G5:R5")) Is Nothing Then
ActiveCell.AddComment
ActiveCell.Comment.Visible = True
' ActiveCell.Comment.Text Text:=Format(CStr(ActiveCell.Value / Cells(11, 2)) * 100, " #,##0.00") & " %" 'La formule originale
ActiveCell.Comment.Text Text:= ? 'La formule recherchée (j'ai pensé à un sommeprod avec le service (0001) et les series (réalisé) mais sans résultats probants
End If

End Sub


Le résultat espéré dans mon fichier "Suivi consommation" :

Le commentaire de la cellule "G5" (5,19%) doit afficher 4 418 403,56 (montant réalisé dans mon fichier source)

Le commentaire de la cellule "H5" (12,06%) doit afficher 10 263 451,35 (montant réalisé dans mon fichier source)


Ci-joint mes deux fichiers épurés ne gardant qu'un seul onglet avec un seul service


Bien cordialement
Quincy
 

Pièces jointes

  • Quincy.zip
    14.3 KB · Affichages: 44
  • Quincy.zip
    14.3 KB · Affichages: 44
  • Quincy.zip
    14.3 KB · Affichages: 40
Trier par date Trier par votes
P

PMO2

XLDnaute Accro
Re : Résultat d'une formule dans commentaire par macro

Bonjour,

Une solution avec le code évènementiel ci-dessous. J'utilise l'évènement Worksheet_Calculate de la feuille "DEPENSES Fonctionnement".

Restrictions
1) Le classeur source et le classeur macro doivent être dans le même dossier
2) Si le nom de ce dossier contient une ou plusieurs apostrophes ( ' ) alors la macro plante
Exemple : C:\Documents and Settings\Patrick\Bureau\Résultat d'une formule dans commentaire par macro

Avantage
Il n'est pas nécessaire que le classeur source soit ouvert

Code: 
'### Eventuellement, adapter les constantes ###
Const MA_SOURCE As String = "\[Dépenses (source).xls]Fonctionnement'!"
Const MA_PLAGE As String = "G5:R5"
'##############################################

Private Sub Worksheet_Activate()
Call Worksheet_Calculate
End Sub

Private Sub Worksheet_Calculate()
Dim R As Range
Dim C As Range
Dim CM As Comment
Dim A$
Dim var
If ActiveSheet.Name <> "DEPENSES Fonctionnement" Then Exit Sub
Set R = Range(MA_PLAGE)
Application.ScreenUpdating = False
For Each C In R
  On Error Resume Next
  C.Comment.Delete
Next C
Err.Clear
For Each C In R
  If C <> "" Then
    On Error GoTo Erreur
    A$ = "'" & ThisWorkbook.Path & MA_SOURCE & _
        C.Offset(-2, 0).Address(ReferenceStyle:=xlR1C1)
    var = ExecuteExcel4Macro(A$)
    If var <> "" And IsNumeric(var) Then
      Set CM = C.AddComment
      CM.Visible = True
      CM.Text Text:=Format(var, "# ### ### ##0.00")
    End If
    CM.Shape.Select True
    With Selection
      With .Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .ColorIndex = 5
      End With
      .AutoSize = True
      .ShapeRange.Fill.ForeColor.SchemeColor = 41
      .Placement = xlMove
      .PrintObject = True
      .Visible = False
    End With
  End If
Next C
Erreur:
Application.ScreenUpdating = True
If Err = 1004 Then
  MsgBox prompt:="Erreur 1004" & vbCrLf & vbCrLf & _
    "Le chemin ci-dessous contient au moins une apostrophe :" & _
    vbCrLf & ThisWorkbook.Path & vbCrLf & vbCrLf & _
    "Veuillez le(s) retirer.", Buttons:=vbCritical, _
    Title:="Programme stoppé - Apostrophe interdite dans le chemin"
ElseIf Err <> 0 Then
  MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Bonsoir le forum, bonsoir PMO2,

PMO2, je vous remercie pour votre contribution et si votre macro répond à mon problème cela va grandement me faciliter la tâche d'autant plus que je pensais que ma demande était passée aux oubliettes.

De plus, je vous suis très reconnaissant d'avoir détaillé votre macro très complexe pour la rendre facilement compréhensible.

J'ai cependant un gros doute, bien que mon fichier complet soit au boulot, j'ai testé avec le fichier que vous m'avez renvoyé : j'ai dupliqué plusieurs fois les quatre lignes du service 0001 pour avoir un 0002, un 0003, un 0004 etc dans le fichier source et dupliqué plusieurs fois la ligne 0001 pour avoir une ligne 0002, une 0003, une 0004 etc dans le fichier "Suivi consommation", modifié les chiffres et modifié la plage de cellules dans la macro. J'aurai voulu là ne récupérer que les montants des lignes "Réalisé" pour qu'ils se placent dans les commentaires, mais je pense que cela ne marche pas, sans doute parce que je n'ai qu'une ligne d'un côté pour quatre lignes de l'autre.

J'essaierai demain au boulot mais je reste dubitatif.

Je vous souhaite une bonne soirée.
Bien cordialement.

Quincy
 
Dernière édition:
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Bonjour à tous,

Effectivement la macro de PMO2 est très bien concue mais malheureusement pas adaptée à la structure de mon fichier.

Je reviens donc à ma première macro et bute toujours sur une formule :

Dans une cellule Excel la formule suivante marche :

=SOMMEPROD(('[Dépenses (source).xls]Fonctionnement'!$E1:$E5=D20)*('[Dépenses (source).xls]Fonctionnement'!$F1:$F5="Réalisé")*('[Dépenses (source).xls]Fonctionnement'!$G1:$G5))

Dans une macro elle ne marche pas :

ActiveCell.Comment.Text Text:= _
"=SUMPRODUCT(('[Dépenses (source).xls]Fonctionnement'!R[-16]C5:R[-12]C5=R17C4)*('[Dépenses (source).xls]Fonctionnement'!R[-16]C6:R[-12]C6=""Réalisé"")*('[Dépenses (source).xls]Fonctionnement'!R[-16]C:R[-12]C))"

En fait le commentaire fait apparaître le texte de la formule au lieu de son résultat.

Si vous voyez une solution à mon problème...
Cordialement
Quincy
 

Pièces jointes

  • Quincy2.zip
    17 KB · Affichages: 29
  • Quincy2.zip
    17 KB · Affichages: 29
  • Quincy2.zip
    17 KB · Affichages: 28
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Bonjour à tous

Finalement je pense avoir trouvé la bonne formule,

=INDEX(Val;EQUIV($A5;Service;0);EQUIV(G$1;Mois;0))

qui marche bien en formule excel mais que je n'arrive toujours pas déclarer dans ma macro afin que le résultat s'affiche dans le commentaire et non la formule en format texte.

Les noms que j'ai définis dans mon classeur (val, Service, Mois) sont-ils aussi à déclarer dans la macro (Dim) ?

N'y aurait-il vraiment pas quelqu'un pour se pencher sur mon problème ?

Cordialement
Quincy
 

Pièces jointes

  • Quincy3.zip
    17.5 KB · Affichages: 32
  • Quincy3.zip
    17.5 KB · Affichages: 33
  • Quincy3.zip
    17.5 KB · Affichages: 30
Dernière édition:
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : Résultat d'une formule dans commentaire par macro

Bonjour,

Une nouvelle mouture en utilisant l'évènement SelectionChange et en prenant en compte des champs dupliqués
pour obtenir les services 0001 à 0008. Voyez si l'exemple, en pièce jointe, vous convient.

Code à copier dans la fenêtre de code de la feuille DEPENSES Fonctionnement (virez mon ancien code)
Code: 
'### Eventuellement, adapter les constantes ###
Const MA_SOURCE As String = "\[Dépenses (source).xls]Fonctionnement'!"
Const MA_PLAGE As String = "G5:R5"
Const INCREMENT As Long = 4
'##############################################

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Dim R2 As Range
Dim C As Range
Dim CM As Comment
Dim A$
Dim var
Dim lastLig&
Dim i&
Set R = Range(MA_PLAGE)
lastLig& = ActiveSheet.[f65536].End(xlUp).Row
If lastLig& > INCREMENT * 2 Then Set R2 = R
For i& = Range(MA_PLAGE).Row + INCREMENT To lastLig& Step INCREMENT
  Set R2 = R2.Offset(INCREMENT, 0)
  Set R = Application.Union(R, R2)
Next i&
For Each C In R
  On Error Resume Next
  C.Comment.Delete
Next C
Err.Clear
Set R2 = Range(Target.Address)
If Application.Intersect(R, R2) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If R2 <> "" Then
  On Error GoTo Erreur
  A$ = "'" & ThisWorkbook.Path & MA_SOURCE & _
      R2.Offset(-2, 0).Address(ReferenceStyle:=xlR1C1)
  var = ExecuteExcel4Macro(A$)
  If var <> "" And IsNumeric(var) Then
    Set CM = R2.AddComment
    CM.Visible = True
    CM.Text Text:=Format(var, "# ### ### ##0.00")
  End If
  CM.Shape.Select True
  With Selection
    With .Font
      .Name = "Arial"
      .FontStyle = "Gras"
      .Size = 10
      .ColorIndex = 5
    End With
    .AutoSize = True
    .ShapeRange.Fill.ForeColor.SchemeColor = 41
    .Placement = xlMove
    .PrintObject = True
  End With
  R2.Select
End If
Erreur:
Application.ScreenUpdating = True
If Err = 1004 Then
  MsgBox prompt:="Erreur 1004" & vbCrLf & vbCrLf & _
    "Le chemin ci-dessous contient au moins une apostrophe :" & _
    vbCrLf & ThisWorkbook.Path & vbCrLf & vbCrLf & _
    "Veuillez le(s) retirer.", Buttons:=vbCritical, _
    Title:="Programme stoppé - Apostrophe interdite dans le chemin"
ElseIf Err <> 0 Then
  MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Bonjour PMO2 et merci beaucoup pour votre travail.

Je vais essayer de partir sur la voie que vous me donnez, ma première demande qui me paraissait pourtant plus simple n'ayant pas été fructueuse.

Je pense qu'en masquant les lignes que vous avez dupliquées cela devrait aller.

Cependant je me posais la question suivante: dans votre première macro, aurions-nous pû déclarer MA_PLAGE du style ("G5:R5";"G9:R9";"G13:R13";G17:R17"; etc..) ?

En tout cas merci pour votre investissement.
Bonne journée
Quincy
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Quincy à dit:
Cependant je me posais la question suivante: dans votre première macro, aurions-nous pû déclarer MA_PLAGE du style ("G5:R5";"G9:R9";"G13:R13";G17:R17"; etc..) ?
Quincy
Cliquez pour agrandir...

Je crois que j'ai dis une bétise là. J'ai tout mélangé.
Mon raisonnement était plutôt de dire que la plage source était une ligne sur quatre à partir de G3:R3.
Enfin peut-être.
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : Résultat d'une formule dans commentaire par macro

Bonjour,

La 3ème version qui tient compte de
parce que je n'ai qu'une ligne d'un côté pour quatre lignes de l'autre

Voyez la pièce jointe si cela vous convient mieux.

Code: 
'### Eventuellement, adapter les constantes ###
Const MA_SOURCE As String = "\[Dépenses (source).xls]Fonctionnement'!"
Const MA_PLAGE As String = "G3:R" 'où G3 est la 1ère cellule et R est la dernière colonne (la dernière ligne sera spécifiée par le programme)
'##############################################

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Dim R2 As Range
Dim C As Range
Dim CM As Comment
Dim A$
Dim var
Dim lastLig&
Dim i&
lastLig& = ActiveSheet.[f65536].End(xlUp).Row
Set R = Range(MA_PLAGE & lastLig& & "")
For Each C In R
  On Error Resume Next
  C.Comment.Delete
Next C
Err.Clear
Set R2 = Range(Target.Address)
If Application.Intersect(R, R2) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If R2 <> "" Then
  On Error GoTo Erreur
  A$ = "'" & ThisWorkbook.Path & MA_SOURCE & _
      R2.Offset(3 * (R2.Row - 3), 0).Address(ReferenceStyle:=xlR1C1)
  var = ExecuteExcel4Macro(A$)
  If var <> "" And IsNumeric(var) Then
    Set CM = R2.AddComment
    CM.Visible = True
    CM.Text Text:=Format(var, "# ### ### ##0.00")
  End If
  CM.Shape.Select True
  With Selection
    With .Font
      .Name = "Arial"
      .FontStyle = "Gras"
      .Size = 10
      .ColorIndex = 5
    End With
    .AutoSize = True
    .ShapeRange.Fill.ForeColor.SchemeColor = 41
    .Placement = xlMove
    .PrintObject = True
  End With
  R2.Select
End If
Erreur:
Application.ScreenUpdating = True
If Err = 1004 Then
  MsgBox prompt:="Erreur 1004" & vbCrLf & vbCrLf & _
    "Le chemin ci-dessous contient au moins une apostrophe :" & _
    vbCrLf & ThisWorkbook.Path & vbCrLf & vbCrLf & _
    "Veuillez le(s) retirer.", Buttons:=vbCritical, _
    Title:="Programme stoppé - Apostrophe interdite dans le chemin"
ElseIf Err <> 0 Then
  MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

re,

PMO2, avec cette nouvelle version je pensais tenir le bon bout. Tout me semblait nickel mais quand j'ai voulu transposer la macro à mon fichier complet j'ai un décalage des résultats (dans la bonne colonne mais pas dans les bonnes lignes).

A priori votre macro, pour le peu que je comprends, est basée sur la structure du fichier source (nb lignes) et non sur des liaisons (n° de service source, n° de service cible).

J'essaie de voir tout çà et je vous tiens au courant.

Merci beaucoup
Cordialement
Quincy
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Re,

Bon ça marche mais j'ai bidouillé donc pas du tout dans les règles de l'art que vous connaissez apparemment du bout des doigts.

1) Dans le fichier qui contient la macro, j'ai réinséré le lignes des écarts types car j'en ai besoin et donc modifié dans la macro la variable MA_PLAGE en "G5:R" au lieu de "G3:R".

2) Dans le fichier source j'ai dû insérer huit lignes !!! au dessus de la première d'en-tête de colonnes pour voir afficher les bons résultats.

3) Je pense que par la suite il faut que je fasse attention à avoir tous mes services sur les deux classeurs pour éviter un risque de décalage malencontreux.

Quincy
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : Résultat d'une formule dans commentaire par macro

Bonjour,

La 4ème et dernière version qui tient compte de différents réglages d'écart entre lignes d'un classeur à l'autre.

Voyez la pièce jointe si cela vous convient mieux.

Code: 
'### Eventuellement, adapter les constantes ###
Const MA_SOURCE As String = "\[Dépenses (source).xls]Fonctionnement'!"
Const MA_PLAGE As String = "G5:R" 'où G5 est la 1ère cellule et R est la dernière colonne (la dernière ligne sera spécifiée par le programme)
Const DEPART_DEST As Long = 5     'ligne de départ de la feuille commentaire (correspond au x de Gx de la ligne du dessus (ex : 5 pour "G5:R"))
Const DEPART_SOURCE As Long = 3   'ligne de départ de la feuille source
'##############################################

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Dim R2 As Range
Dim C As Range
Dim CM As Comment
Dim A$
Dim var
Dim lastLig&
Dim i&
lastLig& = ActiveSheet.[f65536].End(xlUp).Row
Set R = Range(MA_PLAGE & lastLig& & "")
For Each C In R
  On Error Resume Next
  C.Comment.Delete
Next C
Err.Clear
Set R2 = Range(Target.Address)
If Application.Intersect(R, R2) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If R2 <> "" Then
  On Error GoTo Erreur
  A$ = "'" & ThisWorkbook.Path & MA_SOURCE & _
      R2.Offset(((R2.Row - DEPART_DEST) * DEPART_SOURCE) + DEPART_SOURCE - DEPART_DEST, 0).Address(ReferenceStyle:=xlR1C1)
  var = ExecuteExcel4Macro(A$)
  If var <> "" And IsNumeric(var) Then
    Set CM = R2.AddComment
    CM.Visible = True
    CM.Text Text:=Format(var, "# ### ### ##0.00")
  End If
  CM.Shape.Select True
  With Selection
    With .Font
      .Name = "Arial"
      .FontStyle = "Gras"
      .Size = 10
      .ColorIndex = 5
    End With
    .AutoSize = True
    .ShapeRange.Fill.ForeColor.SchemeColor = 41
    .Placement = xlMove
    .PrintObject = True
  End With
  R2.Select
End If
Erreur:
Application.ScreenUpdating = True
If Err = 1004 Then
  MsgBox prompt:="Erreur 1004" & vbCrLf & vbCrLf & _
    "Le chemin ci-dessous contient au moins une apostrophe :" & _
    vbCrLf & ThisWorkbook.Path & vbCrLf & vbCrLf & _
    "Veuillez le(s) retirer.", Buttons:=vbCritical, _
    Title:="Programme stoppé - Apostrophe interdite dans le chemin"
ElseIf Err <> 0 Then
  MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Q

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Résultat d'une formule dans commentaire par macro

Bonsoir le forum, bonsoir PMO2,

Merci beaucoup PMO2 vous êtes formidable surtout que vous avez été mon unique intervenant sur ce coup là, ce que je ne m'explique pas. Mais bon !

Je testerai donc demain au boulot.

Bonne soirée à vous.
Cordialement
Quincy
 
Vote positif 0 Vote négatif

Discussions similaires

jeff1494
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
X
  • Résolu(e)
Microsoft 365 VBA code qui efface un commentaire écrit dans une cellule, suivant le résultat d'une autre
2
Réponses
18
Affichages
1 K
xxexcel
X
A
  • Question
Microsoft 365 Copier le contenu d'une feuille dans une autre par une macro
Réponses
2
Affichages
909
AlexAGEMS
A
V
  • Résolu(e)
Microsoft 365 Afficher filtres appliqués par macro dans la cellule B3 directement et non par F5 puis Réinitialiser
Réponses
12
Affichages
1 K
VirginieG
V
S
  • Question
VBA : Utiliser le résultat d'une InputBox comme critère dans une formule
Réponses
14
Affichages
5 K
Dranreb
Dranreb
chris6999
  • Question
Macro : copier une ligne dans la première ligne vide d'une autre feuille
Réponses
2
Affichages
4 K
chris6999
chris6999
B
  • Question
Définition varible dans un TreeView
Réponses
1
Affichages
964
gosselien
gosselien
M
  • Question
Intégrer un autre If dans une macro existante
Réponses
4
Affichages
2 K
matthieu2701
M
M
  • Question
macro avec IF
Réponses
0
Affichages
930
matthieu2701
M
urbanito1
  • Question
MACRO DEBUTANT copie d'une macro dans une feuille EXCEL
Réponses
3
Affichages
6 K
urbanito1
urbanito1

Membres actuellement en ligne

15 membres et 175 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 629
Messages
2 111 345
Membres
111 110
dernier inscrit
chergui