Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro Graphique simple

LBi

XLDnaute Junior
Bonsoir,
Pour peaufiner mon tableau biologique, j'aurais aimé ajouter des graphiques qui se créeraient à la demande en cliquant sur des liens texte dans la colonne B de la feuille T1 et s'effaceraient en cliquant sur le tableau.
L'enregistrement de macro ne fonctionne pas bien pour les graphiques. Le résultat une fois lancé est différent.
Second problème les données biologiques ne sont pas contiguës pour l'hémoglobine dans l’exemple 12-9-vide-14-12.9 sont en F-J-N-R-V et pour 50 résultats biologiques dans le tableau final il faudrait trouver une solution pour sélectionner les données (1 sur 5 de partant de F4) .
Merci de votre aide

il me met erreur d’exécution 1004 ligne en gras

Sub Macro4()
Range("F4,J4,N4,R4,V4").Select
Range("V4").Activate
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
ActiveChart.SetSourceData Source:=Range( _
"'T1'!$F$4,'T1'!$J$4,'T1'!$N$4,'T1'!$R$4,'T1'!$V$4")
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 228
ActiveChart.Axes(xlValue).MajorGridlines.Select
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).Name = "='T1'!$B$4:$D$4"
ActiveChart.FullSeriesCollection(1).XValues = _
"='T1'!$F$3,'T1'!$J$3,'T1'!$N$3,'T1'!$R$3,'T1'!$V$3"
ActiveChart.DisplayBlanksAs = xlInterpolated
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).TickLabels.NumberFormatLinked = -1
ActiveChart.Axes(xlCategory).TickLabels.NumberFormatLinked = 0
Selection.TickLabels.NumberFormat = "j/m/aa;@"
ActiveChart.Axes(xlCategory).CategoryType = xlCategoryScale
ActiveChart.Axes(xlCategory).CrossesAt = 1
ActiveChart.Axes(xlCategory).AxisBetweenCategories = False
Selection.TickLabels.Orientation = 45
Application.CommandBars("Format Object").Visible = False
ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)
ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
Range("AD21").Select
ActiveSheet.ChartObjects("Graphique 5").Activate
ActiveSheet.Shapes("Graphique 5").IncrementLeft -496.8749606299
ActiveSheet.Shapes("Graphique 5").IncrementTop -214.3750393701
ActiveSheet.ChartObjects("Graphique 5").Activate
ActiveSheet.Shapes("Graphique 5").ScaleWidth 1.7170137795, msoFalse, _
msoScaleFromTopLeft
End Sub

 

Pièces jointes

  • Tableau biologique.xlsm
    82 KB · Affichages: 38

Lone-wolf

XLDnaute Barbatruc
Bonjour LBi, le Forum

@LBi

Ton fichier en retour. J'ai supprimé tous les modules inutiles. Double-clique sur un nom en colonne B et vois le résultat.
 

Pièces jointes

  • Tableau biologique.xlsm
    74.5 KB · Affichages: 33
Dernière édition:

LBi

XLDnaute Junior
Merci de votre aide
- Il faudrait que les dates soient sur les axes des verticales.
- Le formatage des dates n'est pas bon au bout du 2ème graphiques - 17 janvier 2017
- Comment faire pour que les cellules vides ne soient pas prises en compte : par exemple ligne 48 Albumine
- Est-il possible de cliquer sur le graphique pour le fermer ?
- Hyperlien ou double clique dans la colonne B pour ouvrir le graphique (Quand les colonnes ABCD sont protégées le double clique ne fonctionne plus)
- Il faudrait également que le graphique s'ouvre en dessous de la ligne des données biologiques, pour pouvoir les visualisées comme sur l'image.
Cordialement

 

job75

XLDnaute Barbatruc
Bonjour LBi, Lone-wolf, le forum,

Voyez ce fichier (4) - suite de l'autre fil - et ces 2 macros dans le code de la feuille "T1" :
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ChartObjects(1).Visible = False 'masque le graphique
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Or Target.Row < 4 Then Exit Sub
Dim c As Range, v, n%, a(), b(), Lmax%
Cancel = True
For Each c In Intersect(Rows(3), UsedRange)
    v = Cells(Target.Row, c.Column)
    If IsDate(c) And v <> "" Then
        n = n + 1
        ReDim Preserve a(1 To n): ReDim Preserve b(1 To n)
        a(n) = c.Text
        b(n) = v
        If Len(v) > Lmax Then Lmax = Len(v)
    End If
Next
If n = 0 Then Exit Sub
ThisWorkbook.Names.Add "X", a 'nom défini
ThisWorkbook.Names.Add "Y", b 'nom défini
With ChartObjects(1)
    .Top = Target(2, 1).Top
    .Left = Columns(6).Left
    .Width = Columns(6).Resize(, 4 * n).Width
    With .Chart.SeriesCollection(1)
        .Name = Target(1)
        .XValues = "='" & ThisWorkbook.Name & "'!X" 'abscisses
        .Values = "='" & ThisWorkbook.Name & "'!Y" 'ordonnées
        .MarkerSize = 14 + 3 * Lmax 'taille des marqueurs
    End With
    .Visible = Not .Visible 'affiche/masque le graphique
End With
End Sub
Il y a un seul graphique dans la feuille, il s'affiche par double-clic en colonne B.

Bonne journée.
 

Pièces jointes

  • Tableau biologique(4).xlsm
    79.1 KB · Affichages: 29

job75

XLDnaute Barbatruc
Re,

Le double-clic est la meilleure solution, si la feuille est protégée il suffit de la déprotéger pendant l'exécution de la macro :
Code:
Unprotect "LBi" 'déprotection, mot de passe à adapter
'---suite de la macro---
Protect "LBi" 'protection, mot de passe à adapter
Fichier (4 bis).

A+
 

Pièces jointes

  • Tableau biologique(4 bis).xlsm
    78 KB · Affichages: 25

Lone-wolf

XLDnaute Barbatruc
Bonjour Gérard , Re LBi

@LBi: pour ne pas afficher les zéro, il suffit de les supprimer en laissant les cellules vides comme dans la ligne Hémoglobines. Et pour le format Date, tu avais mis dans la macro "j/m/a;@" non?
 

LBi

XLDnaute Junior
Super, ça fonctionne @job75.
Pour peaufiner encore un peu ce graphique, peut-on y ajouter 2 lignes horizontales en pointillé pour suggérer les valeurs normales ou 1 ligne pour les "inf à"
Merci
 
Dernière édition:

LBi

XLDnaute Junior
Bonjour @Lone-wolf ,
  1. Pour le format date dans l'image le graphique du bas réalisé par la macro avait un format de date incorrect.
    1a) la solution de job 75 me convient.
  2. pour ne pas afficher les zéro, il suffit de les supprimer en laissant les cellules vides comme dans la ligne Hémoglobines
    2a) merci de ta proposition - solutionné par job75
Si tu as d'autres propositions pour améliorer le graphique, je suis preneur.

Merci
 

job75

XLDnaute Barbatruc
Re,

Dans le fichier (4 bis) je viens encore de modifier la macro Macro1 :
Code:
        With Sheets("T1")
            .Protect "LBi", UserInterfaceOnly:=True 'la protection est ignorée
            DerCol = .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
            If DerCol > 6 Then .Columns(DerCol - 4).Resize(, 4).Copy .Columns(DerCol) 'pour copier les formats
            '------------
A+
 

job75

XLDnaute Barbatruc
Re,

Intégrer ? Vous plaisantez.

Mon fichier (4 bis) est opérationnel, vous pouvez effacer les données des colonnes F:Y pour en mettre d'autres.

Alors que dans votre fichier (5) il n'y a même pas les bonnes MFC !

A+
 

Modeste geedee

XLDnaute Barbatruc

Pièces jointes

  • Tableau biologique(4 bis) (1).xlsm
    81.4 KB · Affichages: 23
  • Tableau biologique(4 bis) (1).xlsm
    81.4 KB · Affichages: 49

LBi

XLDnaute Junior
Bonsoir,

Loin de moi l'idée de penser que mon tableau soit meilleur que le vôtre, qui est vraiment super. (Je ne pensais pas arriver à ce niveau d’intégration de données)

Je vais essayer de m'expliquer.
Le tableau formaté avec 50 colonnes vides pèse 180k contre 57k d'origine.
Les patients peuvent avoir seulement 1 ou 2 résultats biologiques comme en avoir une centaine dans le même tableau d'ou l’intérêt d'avoir un tableau qui se remplisse au fur et à mesure ce qui éviterait d'avoir de trop gros fichiers, vu qu'il y a plusieurs millier de Tableaux bio à stocker.

Une idée serait de pouvoir coller les données avec format de la feuille Nouvelle vers la feuille T1.

Très cordialement.
 

Pièces jointes

  • Tableau biologique.xlsm
    180.7 KB · Affichages: 24

Discussions similaires

Réponses
0
Affichages
352
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…