avis aux formulistes : formule de définition des min et max des axes d'un mapping

ledzepfred

ledzepfred

XLDnaute Impliqué
Bonsoir à tous

Je vous sollicite pour un petit problème : j'ai un fichier excel permettant de créer 33 mappings et de les coller dans un modèle de présentation powerpoint, tout fonctionne à merveille sauf la définition par formules des min et max de chacun de mes axes, actuellement ces bornes sont l'arrondi supérieur/inférieur du max/min de mes plages de valeurs pour X et Y, ces formules ne tiennent pas compte de la taille max des bulles, du coup elles sont coupées, j'avais essayé de retrancher/ajouter 1 ou 0,5 à ces valeurs mais le résultat ne me plait pas trop pour certains mappings).
Je suis sur que les formulistes de talent qui trainent par ici ne feront qu'une bouchée de ce petit pb.

Voir le fichier joint

Merci de votre aide
 

Pièces jointes

  • Pour Alim Mapping.zip
    137.7 KB · Affichages: 80
  • Pour Alim Mapping.zip
    137.7 KB · Affichages: 77
  • Pour Alim Mapping.zip
    137.7 KB · Affichages: 78
Trier par date Trier par votes
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonsoir Cisco,

tu as tout à fait raison d'autant que cette routine n'est pas pour moi mais pour un collègue qui souhaitait automatiser la création des mappings.

Merci encore pour ton aide précieuse.

A+
 
Vote positif 0 Vote négatif
Gruick

Gruick

XLDnaute Accro
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonjour Patrick, et tous les intervenants de ce fil.

Etant inconditionnel des codes signés PMO2, je n'ai pas pu résister
mais la belle macro ne résiste pas au produit 3.
Ses deux valeurs extrèmes coïncident avec la plus grosse bulle violette, en dernière ligne.
Chez moi la bulle est coupée juste au niveau du trait, je n'ose pas poster mon travail. J'ai aussi utilisé ∏, mais en formules, et n'ai pas touché aux macros exceptionnellement.

Gruick
 
Vote positif 0 Vote négatif
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

bonsoir à tous,

et merci à Patrick pour ce superbe code qu'il faudra que je teste en mode debogage pour le décortiquer (je sens que je vais me régaler).:)

La solution de Cisco me convient parfaitement puisque seules quelques bulles résistent mais le fait de coller l'objet en tant qu'objet graphique permet de modifier les min et max en manuel dans ma présentation, du coup je suis en train de créer une macro powerpoint pour copier les objets graphiques et de les coller en tant qu'image après correction éventuelle.

Maintenant c'est pour le fun et/ou pour la perfection, ce que donnera peut-être le code de Patrick, c'est aussi pour ça que ta piste, Gruick mon ami, m'interesse, n'aies donc point honte de ton travail, ce serait dommage d'avoir perdu du temps là dessus pour ne pas nous en faire profiter.:)

A+
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonjour à tous,

Merci à Gruick, mon fidèle lecteur, de me dire que la piste que j'ai précédemment fait paraître ne fonctionne pas bien.
Je me suis inspiré des travaux de ledzepfred, de Gruick et de Cisco pour repartir sur une autre approche qui a l'air de tenir la route.
Je n'ai pu résister à intervenir sur le programme PowerPoint de ledzepfred.

Voici donc le nouveau code dont l'idée est toute de vous

module1
Code: 
'''Menu Outils/Références... Library PowerPoint
'''C:\Program Files\Microsoft Office\OFFICE11\msppt.olb
'''Microsoft PowerPoint 11.0 Object Library

'### Constante à adapter ###
Const PPT_CHEMIN As String = "c:\Essai mapping.ppt"
'###########################

Sub MAJ_graphiqueDansPresentation()
Dim S As Worksheet
Dim i&
Dim j&
Dim NbShape&
Dim Gauches As Variant
Dim Tops As Variant
Dim PPT As PowerPoint.Application
Dim PRES As PowerPoint.Presentation
Dim PRES2 As PowerPoint.Application
Dim SH As PowerPoint.Shape
Dim A$
Dim B$
Dim TitreStatus$
Gauches = Array(, 6, 360, 6)
Tops = Array(, 104, 104, 300)
APPEL = True
On Error GoTo Erreur
Set S = Sheets("Source graphe")
S.Activate
Application.ScreenUpdating = False
  '--- Ouvre une instance de PowerPoint et la présentation modèle ---
Set PPT = CreateObject("PowerPoint.Application")
PPT.WindowState = ppWindowMinimized
Set PRES = PPT.Presentations.Open(PPT_CHEMIN, WithWindow:=msoFalse)
  '--- Supprime les Shapes ayant un nom défini existant ---
On Error Resume Next
For i& = 1 To 11
  For j& = 1 To 3
    Set SH = PRES.Slides(i&).Shapes("NOM" & i& * 10 + j&)
    If Not SH Is Nothing Then SH.Delete
  Next j&
Next i&
Err.Clear
  '---------------------------------------------------------
On Error GoTo Erreur
TitreStatus$ = Space(11) & " Export dans PowerPoint"
For i& = 1 To 11
  For j& = 1 To 3
    Application.StatusBar = Mid(TitreStatus$, i&)
    Application.Goto Reference:="NOM" & i& * 10 + j&  ' sélectionne la plage à copier dans graphe source
    Set R = Selection
    Call MAJ_graphique
    ActiveChart.ChartArea.Copy
    With PRES.Slides(i&)              ' active la diapo
      .Shapes.PasteSpecial ppPasteEnhancedMetafile ' colle le graphique source en tant qu' image
      NbShape = .Shapes.Count
      With .Shapes(NbShape)
        .Name = "NOM" & i& * 10 + j&  ' définit le nom du graphique collé
        .Left = Gauches(j&)           ' définit la position horizontale dans la diapo
        .Top = Tops(j&)               ' définit la position verticale dans la diapo
        .Height = 189.88              ' définit la hauteur du graphique
        .Width = 348.88               ' définit la largeur du graphique
        .ZOrder msoSendToBack         ' arriere plan
      End With
    End With
  Next j&
Next i&
  '--- Modèle ppt : Path et nom du fichier ---
A$ = Mid(PPT_CHEMIN, 1, InStrRev(PPT_CHEMIN, "\"))
B$ = Mid(PPT_CHEMIN, Len(A$) + 1)
B$ = Mid(B$, 1, Len(B$) - 4)
i& = 0
  '--- Vérification du nom du nouveau fichier (si déjà existant on incrémente _x)
With Excel.Application.FileSearch
  Do
    i& = i& + 1
    .Filename = B$ & "_" & i& & ".ppt"
    .LookIn = A$
    .Execute
  Loop Until .FoundFiles.Count = 0
  B$ = .Filename
End With
  '--- Enregistre une copie et ferme la présentation ---
With PRES
  .SaveCopyAs A$ & B$
  .Close
End With
PPT.Quit
Erreur:
If Err <> 0 Then
  MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
  If Not PRES Is Nothing Then PRES.Close
  If Not PPT Is Nothing Then PPT.Quit
End If
Set PRES = Nothing
Set PPT = Nothing
Set R = Nothing
APPEL = False
S.[a1].Select
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

module2
Code: 
Public APPEL As Boolean
Public R As Range

Type structPropertyXY
  Value As Double
  Size As Double
End Type
Type structXY
  MinX As structPropertyXY
  MinY As structPropertyXY
  MaxX As structPropertyXY
  MaxY As structPropertyXY
End Type

Sub MAJ_graphique()
Dim XY As structXY
Dim AJOUT As Double
Dim S As Worksheet
Dim var
Dim i&
Dim lig&
Dim col&
Dim SizeMax As Double
Set S = Sheets("Source graphe")
S.Activate
If Not APPEL Then
  On Error Resume Next
  Range("B15:D25").Interior.ColorIndex = xlNone
  lig = ActiveCell.Row
  col = ActiveCell.Column
  Application.Goto Reference:=ActiveCell.Value
  If Err = 1004 Then
    Range("B15:D25").Activate
    MsgBox ("Sélectionnez une cellule parmi ce tableau en fonction du produit et du mois")
    Exit Sub
  End If
  On Error GoTo Erreur
  Set R = Selection
End If
var = R
With XY
  With .MaxX
    .Value = var(1, 3)
    .Size = var(1, 5)
  End With
  With .MinX
    .Value = var(1, 3)
    .Size = var(1, 5)
  End With
  With .MaxY
    .Value = var(1, 4)
    .Size = var(1, 5)
  End With
  With .MinY
    .Value = var(1, 4)
    .Size = var(1, 5)
  End With
End With
SizeMax = -9999999
For i& = 1 To R.Rows.Count
  If SizeMax < var(i&, 5) Then SizeMax = var(i&, 5)
  With XY
    With .MaxX
      If var(i&, 3) > .Value Then
        .Value = var(i&, 3)
        .Size = var(i&, 5)
      End If
    End With
    With .MinX
      If var(i&, 3) < .Value Then
        .Value = var(i&, 3)
        .Size = var(i&, 5)
      End If
    End With
    With .MaxY
      If var(i&, 4) > .Value Then
        .Value = var(i&, 4)
        .Size = var(i&, 5)
      End If
    End With
    With .MinY
      If var(i&, 4) < .Value Then
        .Value = var(i&, 4)
        .Size = var(i&, 5)
      End If
    End With
  End With
Next i&
R.Copy S.Cells(2, 1)
S.ChartObjects("Graphique").Activate
With ActiveChart
  If .ChartGroups(1).SizeRepresents = xlSizeIsWidth Then
    AJOUT = 1   'Diamètre
  Else
    AJOUT = 1.5 'Surface
  End If
  .HasTitle = True
  .ChartTitle.Characters.Text = S.Cells(2, 1) & " " & R.Parent.Name
  With .Axes(xlCategory)
    .TickLabels.NumberFormat = "0.00"
    .MinimumScale = Application.WorksheetFunction.RoundDown(XY.MinX.Value - AJOUT * _
        ((XY.MaxX.Value - XY.MinX.Value) * 1.7 / 10.5) / 2 * (XY.MinX.Size / SizeMax), 2)
    .MaximumScale = Application.WorksheetFunction.RoundUp(XY.MaxX.Value + AJOUT * _
        ((XY.MaxX.Value - XY.MinX.Value) * 1.7 / 10.5) / 2 * (XY.MaxX.Size / SizeMax), 2)
    .CrossesAt = S.Cells(5, 7)
    .MinorUnitIsAuto = True
    .MajorUnitIsAuto = True
  End With
  With .Axes(xlValue)
    .TickLabels.NumberFormat = "0.00"
    .MinimumScale = Application.WorksheetFunction.RoundDown(XY.MinY.Value - AJOUT * _
        ((XY.MaxY.Value - XY.MinY.Value) * 1.7 / 7) / 2 * (XY.MinY.Size / SizeMax), 2)
    .MaximumScale = Application.WorksheetFunction.RoundUp(XY.MaxY.Value + AJOUT * _
        ((XY.MaxY.Value - XY.MinY.Value) * 1.7 / 7) / 2 * (XY.MaxY.Size / SizeMax), 2)
    .CrossesAt = S.Cells(5, 8)
    .MinorUnitIsAuto = True
    .MajorUnitIsAuto = True
  End With
End With
If Not APPEL Then
  With S.Cells(lig, col)
    .Select
    .Interior.ColorIndex = 6
  End With
Else
  Range("B15:D25").Interior.ColorIndex = xlNone
End If
Erreur:
If Err <> 0 Then MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub

Je vous souhaite à tous une excel(lente) soirée.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Gruick

Gruick

XLDnaute Accro
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonjour,

Il fait beau, alors je ne garantis pas ma présence assidue sur le forum.

Toutefois, après mon petit déjeuner, car John Paul Jones, et comme j'ai une Bonham, même si je me Plant, et pour rester à la Page, j'ai laissé plein (!) de formules capillo-tractées dans le fichier afin de suivre le cheminement tarabiscoté de ma réflexion sur le sujet des bulles qui coincent.

Euh, j'en suis le premier étonné... la position de Pi et des opérandes dans les formules semble importante, mais j'ai fait sans comprendre. Si un matheux passe par la...

En gros, j'ai repéré la plus grosse bulle, et comparé si elle coïncidait avec soit un mini ou un maxi des x et des y.

Si Patrick, dont je suis le thuriféraire officiel veut adapter, j'en serai heureux.
J'ai PP mais sur Mac, et ça veux pas.

Bon, ma petite moto s'impatiente,

A plus

Gruick
 

Pièces jointes

  • Pour Alim Mapping - 2.xls.zip
    35.8 KB · Affichages: 9
Vote positif 0 Vote négatif
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Patrick, François,

je vais malheureusement devoir attendre la semaine prochaine pour tester vos solutions (merci la pentecôte). Je reviens vers vous très vite

D'ores et déjà merci pour vos contributions :)

A+
 
Vote positif 0 Vote négatif
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

re...

bon finalement impossible de me coucher là dessus.

Patrick : ben rien à dire c'est génial, je songe même à arrêter de vba coder tellement je suis loin de ce niveau (et pourtant c'est logique et clair!) Ah la vie ne fait pas de cadeaux hein!:D

François : ton approche est interessante, preuve en est, seules quelques bulles (proche de MinX) sont légèrement coupées.
Sachant que l'aire d"un cercle est PixRxR alors le rayon est racine carrée de Aire/Pi (je dis une connerie là??!!!) or ce n'est pas la formule que tu utilises mais Pix2xR qui donne le périmètre d'un cercle (soit la longueur de son contour) et c'est là que je comprends pas car corriger les bornes des axes avec le périmètre donne de meilleurs résultats qu'avec le rayon (???!!!????:eek::eek::eek:). Bizarre aussi l'écriture des deux formules ajust 1.
Par contre, peux-tu expliquer la philosophie de la formule ajust 2 (j'ai pas tout compris) et termes simples STP car Thuriféraire.... (ce mot doit avoir un indice de cochonceté élevé!):D

A+
 
Dernière édition:
Vote positif 0 Vote négatif
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

c'est encore moi

François, j'ai dis une bétise au sujet du périmètre : écrire
Code: 
=MAX(E2:E10)/2*PI()
revient à écrire
Code: 
=PI()*MAX(E2:E10)/2
donc pour l'axe des X tu corriges les bornes par Pi*la moitié de l'aire. Pour l'axe des Y, tu corriges par 2*Aire/Pi, donc rien à voir avec le périmètre dans les deux cas. Ce qui est troublant c'est que tu n'es pas loin de la vérité mais impossible de l'expliquer

Je vois double, je vais me coucher!!!

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Gruick

Gruick

XLDnaute Accro
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonjour aux survivants du sujet et de la Pentecôte...

@ledzepfred
Ai-je évoqué à un seul moment la notion de périmètre ou d'aire ?
Tu te compliques l'existence. La seule chose dont on soit certain dans un rond, c'est ∏. Tout le reste devient proportionnel, mais le sujet n'était pas là.
Il fallait trouver un coefficient pour les axes en respectant les proportions des séries, donc des axes. Quant au 2, c'est parce qu'un axe a deux extrémités, que le graphique est en 2 dimensions, et que le rond ne peut être coupé qu'en 2.
Selon le théorème de Gruick, tout Y est soumis au X et inversement, c'est pour cela que la formule est inversée pour les axes.

La formule de l'ajust 2 est une recherche, et si trouvé, action.
- Rechercher une coïncidence entre la plus grosse bulle (colonne E) et un mini ou maxi dans les autres colonnes (C et D).
- Si sur même ligne, donc recherche fructueuse, ça voudra dire attention, grosse bulle en début ou en fin de graphique, donc possibilité de coupe.
- Ajuster en proportion de l'axe coupable.

@PMO2,
Bien reçu ton mail, répondu par le même chemin.
J'ai doublé l'ajust 2 maintenant, c'est le produit 9 qui fait des siennes. (nom 91 et 92, région 5). Le max reste tranquille, mais c'est l'avant-dernièr qui se singularise. On ne va tout de même pas faire une macro pour ça !!!

A plus,

Gruick
 
Vote positif 0 Vote négatif
ledzepfred

ledzepfred

XLDnaute Impliqué
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Gruick à dit:
Bonjour aux survivants du sujet et de la Pentecôte...

@ledzepfred
Ai-je évoqué à un seul moment la notion de périmètre ou d'aire ?
Tu te compliques l'existence. La seule chose dont on soit certain dans un rond, c'est ∏.
Cliquez pour agrandir...

Excellent théorème! On en aimerait les maths!

Encore merci de ta contribution

A+
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : avis aux formulistes : formule de définition des min et max des axes d'un mappin

Bonjour à tous,

Grâce à l'algorithme de Gruick, on obtient un excellent résultat. Je l'ai donc inclus dans une macro et vous pouvez voir ce que cela donne avec la pièce jointe.

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
Microsoft 365 comparaisons entre les valeurs numerique d'un textbox et des valeurs numerique max et min d'un tableau
Réponses
8
Affichages
635
davterry
D
N
  • Question
XL 2013 Erreur formule MIN MAX et MOYENNE
Réponses
9
Affichages
993
NICOALBERT
N
P
  • Question
Trouver les entêtes de colonne d'après les valeurs Max et Min d'une ligne
Réponses
5
Affichages
2 K
Pierredlv88
P
X
  • Question
Trouver le Min et Max d'une série de données en fonction d'un critère
Réponses
3
Affichages
3 K
Xenors
X
G
  • Question
Choisir max et min des axes graphique à partir de cellules
Réponses
11
Affichages
9 K
jeffe
jeffe

Membres actuellement en ligne

6 membres et 51 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
312 329
Messages
2 087 331
Membres
103 519
dernier inscrit
Thomas_grc11