Discussion :

[Mart29]

Bonjour,
Écologue, j’ai réalisé un suivi de hauteur de végétation sur un linéaire. J’ai donc comme type de résultat par exemple sur 10 m de suivi : 2 mètres de végétation à 50 cm de hauteur moyenne, puis 5 m à 10 cm de moyenne, puis 1 mètre à 20 cm etc.
Je voudrais obtenir un histogramme (longueur du linéaire en abscisse et hauteur de végétation en ordonnée) dont la largeur des barres est proportionnelle à la longueur de chaque portion, afin d'obtenir visuellement une "coupe" de la végétation (si possible avec le nom des espèces pour chaque portion). J’ai vu qu’il fallait passer par une macro. Mais pas expert sur excel, je n’ai pas réussi à la construire. A moins de trouver une astuce en construisant une courbe ?
Merci pour votre aide

[Daniel.C]

Bonjour,

Regarde le classeur joint. C'est ce que j'ai pu faire de plus approchant. Si ça te suffit (en ajoutant le nom des espèces), je peuxx écrire la macro.

Classeur : Mart29 Végét.xls

John Peltier a créé ce qu'il te faut :

http://peltiertech.com/WordPress/var...column-charts/

Je ponds la macro ce soir.

Pas eu le temps de finir ce soir. Je reprends demain.

[cb_60]

Bonjour
J'avais réalisé ce type de graphique il y a quelques temps, ça peut peut être servir.
le premier utilise des barres d'erreur et le second un cumul de barre d'histogramme, ( je crois bien que je m'étais inspiré du site de "Mr Peltier" aussi.

[Mart29]

Bonjour, merci pour votre réactivité!
J'ai aussi pensé à rentrer manuellement les valeurs, mais j'aimerais dans l'idéal un modèle reproductible, par exemple pour comparer rapidement ce même linéaire mais 1 an plus tard, quand la végétation aura changé. Je pense donc que la macro, si elle est faisable, répondrait plus à mon objectif. Daniel si tu as le temps de la construire et de m'expliquer ce serait parfait! Mais ce n'est pas urgent.
Merci

[Daniel.C]

Je bloque sur deux problèmes. Les étiquettes des plantes et celles de l'axe des abscisses. Je m'absente pour l'après-midi. Je reprends au retour.

[mercatog]

Par macro, un peu de gymnastique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Option Explicit
 
Sub Traitement()
Const Pas As Double = 0.1
Dim LastLig As Long, i As Long, j As Long
Dim Tb, Res(), X, Y
Dim Ch As Chart
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    If .ChartObjects.Count > 0 Then .ChartObjects(1).Delete
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    If LastLig > 0 Then
        Tb = .Range("A2").Resize(LastLig, 4)
 
        Tb(1, 4) = Tb(1, 1)
        For i = 2 To LastLig
            Tb(i, 4) = Tb(i, 1) + Tb(i - 1, 4)
        Next i
 
        i = 1
        Do
            DoEvents
            ReDim Preserve Res(1 To 3, 1 To j + 1)
            Res(1, j + 1) = j * Pas
            Res(2, j + 1) = Tb(i, 2)
            If j * Pas > Tb(i, 4) Then
                Res(3, j + 1) = Tb(i, 3)
                i = i + 1
            End If
            j = j + 1
        Loop While i <= LastLig
 
        .Range("G2").Resize(j, 3) = Application.Transpose(Res)
        X = .Range("G2").Resize(j)
        Y = .Range("H2").Resize(j)
        .Range("G2").Resize(j, 3).ClearContents
 
 
        Set Ch = .ChartObjects.Add(240, 20, 600, 340).Chart
        With Ch
            .ChartType = xlColumnClustered
            .ChartArea.ClearContents
            .HasLegend = False
            .HasTitle = False
            .ChartGroups(1).GapWidth = 0
 
            With .SeriesCollection.NewSeries
                .XValues = X
                .Values = Y
                .Interior.Color = RGB(0, 120, 0)
 
                .ApplyDataLabels
                For i = 1 To j
                    With .Points(i).DataLabel
                        .Text = Res(3, i)
                        .Font.Size = 9
                        .Orientation = 90
                    End With
                Next i
            End With
        End With
    End If
End With
End Sub

[Daniel.C]

C'est bon pour Excel 2013. Il faut l'adapter pour Excel 2003. Perso, je persiste à essayer le graph de John Peltier

Ca plante sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.HasTitle = False

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
                .XValues = X
                .Values = Y

[mercatog]

Bon excusez l'oubli, je n'avais pas fait attention à la version d'Excel, j'ai fais les tests sur Xl2007.