graphique à bulles hémicycle de différentes tailles

leoblouson

XLDnaute Nouveau
Bonjour,

Dans Excel 2000, je souhaite créer un graphique avec des bulles dont l'hémisphère haut et l'hémisphère bas représenteraient des variables différentes (les sommes des réponses données aux deux variables en abcisse et en ordonnée).
Cela est-il possible sur excel? Ou sur un autre logiciel? Comment faire?

Merci :)
 

Pièces jointes

  • hémicycles.JPG
    hémicycles.JPG
    1.7 KB · Affichages: 204

HIJACK

XLDnaute Junior
Re : graphique à bulles hémicycle de différentes tailles

HI!
Comme je vois que tu patauges, (un petit peu quand même),
je t'ai bricolé un "machin", ce n'est pas un produit fini, à toi de jouer!
Les 2 petits rectangles rouges que l'on peut masquer doivent être accolés comme dans l'exemple, si on change les dimentions, c'est pour facilité la prise de repères, on se prend vite le chou avec les coordonnées à l'écran et les xy. Pour les sphères j'ai pris le globe terrestre, je ne savais pas à quoi se rapportent tes données. Je peux te les changer si tu veux, yaqadmandé.
Amuse toi bien! (enfin si ce bidule t'intéresse)
Cijoint.fr - Service gratuit de dépôt de fichiers
 

leoblouson

XLDnaute Nouveau
Re : graphique à bulles hémicycle de différentes tailles

Bonjour!

Merci Risleure, je vais essayer de faire ça, mais comment faire moi même ces demi-ronds?
HiJack, j'avoue je galère :) De plus, je n'ai pas pu ouvrir ton fichier .xlsm ... Mon excel ne reconnait pas! Que faire?
je vous tiens au courant de l'avancement des choses du coup
 
Dernière édition:

leoblouson

XLDnaute Nouveau
Re : graphique à bulles hémicycle de différentes tailles

wouaouh quel travail! Cela dit je suis novice en excel, je ne sais pas du tout comment ça peut fonctionner... Que fais-je de la grille? Et du tableur? Comment j'utilise les jolis hémisphères que tu as fait?
Je sens qu'on est pas loin ;)
 

HIJACK

XLDnaute Junior
Re : graphique à bulles hémicycle de différentes tailles

Code:
Sub Macro1()

Sheets("Feuil3").Select
Application.ScreenUpdating = False 'bloque le rafraichissement de l'affichage des pages
   Application.DisplayFullScreen = True 'passe en mode plein écran
    'Application.WindowState = xlNormal
'ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 30, 30).Name = "Rec1"
'ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 30, 30).Name = "Rec2"

'ActiveSheet.Shapes("Rect1").Visible = False 'montre ou cache les rectangles, mais ils sont toujours là
ActiveSheet.Shapes("Rect1").Visible = True
'ActiveSheet.Shapes("Rect2").Visible = False
ActiveSheet.Shapes("Rect2").Visible = True

'Tout ça est à arranger et à mettre en forme

ActiveSheet.ChartObjects("Graphique 1").Activate ' selection du graphe et mise en forme, dim et bornes grille

MinScale = 0
MaxScale = 35
HScale = MaxScale - MinScale
MajUnit = 5
MinUnit = 1

coef0 = 1 ' coefficients pour mise à l'echelle des données si necéssaire
coef1 = 10
coef2 = 60


ActiveSheet.ChartObjects("Graphique 1").Top = 14.25 ' dim du graphe
ActiveSheet.ChartObjects("Graphique 1").Left = 98.25
 ActiveSheet.ChartObjects("Graphique 1").Height = 499.5
ActiveSheet.ChartObjects("Graphique 1").Width = 909

ActiveChart.PlotArea.Select 'ZONE GRAPHE
 ActiveChart.PlotArea.Top = 6.6
 ActiveChart.PlotArea.Left = 1
 ActiveChart.PlotArea.Height = 488
  ActiveChart.PlotArea.Width = 893
  



 a = ActiveSheet.Shapes("Rect1").Top 'recupératuions des coordonnées de la grille pour positionner les hemis
b = ActiveSheet.Shapes("Rect1").Left
c = ActiveSheet.Shapes("Rect2").Top
d = ActiveSheet.Shapes("Rect2").Left

  
  'tout ça est à simplifier, ça reste un brouillon
  
  
    
     ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveChart.Axes(xlValue).MinimumScale = MinScale ' minimum maxim des y
    ActiveChart.Axes(xlValue).MaximumScale = MaxScale
    ActiveChart.Axes(xlValue).MajorUnit = MajUnit ' les x
    ActiveChart.Axes(xlValue).MinorUnit = MinUnit
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 1 'espacement des gradua
    'ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
    ActiveChart.Axes(xlCategory).TickLabelSpacingIsAuto = True
 
Sheets("Feuil4").Select

Select Case Sheets("Feuil4").Cells(3, 4) ' selection des 1/2 hemis sup suivant val tableau
Case Is = 1
img = "IMAS1"
Case Is = 2
img = "IMAS2"
Case Is = 3
img = "IMAS3"
Case Is = 4
img = "IMAS4"
End Select

  
   ActiveSheet.Shapes(img).Copy ' copie sur graphe
   
Sheets("Feuil3").Select
ActiveSheet.Paste

ActiveSheet.Shapes(img).Select
Selection.Name = "IMASX"
'calcul des coordonnées d'affichage et des dim des hemis
Selection.Height = (Sheets("Feuil4").Cells(3, 3) * coef0)
Selection.Top = c - (Sheets("Feuil4").Cells(3, 2) * coef1) - Selection.Height
Selection.Left = b + Sheets("Feuil4").Cells(3, 1) * coef2 - Selection.Height
    
 
Sheets("Feuil4").Select ' rebelotte pour les hemis inf

Select Case Sheets("Feuil4").Cells(3, 6)
Case Is = 1
img = "IMAB1"
Case Is = 2
img = "IMAB2"
Case Is = 3
img = "IMAB3"
Case Is = 4
img = "IMAB4"
End Select

  
   ActiveSheet.Shapes(img).Copy
   
Sheets("Feuil3").Select
ActiveSheet.Paste

ActiveSheet.Shapes(img).Select
Selection.Name = "IMASY"

Selection.Height = (Sheets("Feuil4").Cells(3, 5) * coef0)
Selection.Top = c - (Sheets("Feuil4").Cells(3, 2) * coef1)
Selection.Left = b + Sheets("Feuil4").Cells(3, 1) * coef2 - Selection.Height
 
 
Cells(1, 1).Select
Application.ScreenUpdating = True 'rafraichissement ecran
End Sub


Code:
Sub Image53_Clic()
'effacement des hemis crées
ActiveSheet.Shapes("IMASX").Delete
ActiveSheet.Shapes("IMASY").Delete

End Sub


Encore une fois, au risque de me répéter, c'est un brouillon

A+
 

Discussions similaires

Réponses
8
Affichages
489

Statistiques des forums

Discussions
312 413
Messages
2 088 199
Membres
103 765
dernier inscrit
Pi4