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 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
| '
' Initialisations
' ************************************************************
Worksheets("0845-0920").Activate
PositionGraph = 0
'
' Boucle de traitement pour trouver la position horizontale du graph
' ************************************************************
For Each c In Range("a1:X1")
'
' Addition des largeurs de colonne
' ************************************************************
PositionGraph = PositionGraph + c.Width
Next c
'
' Création de la plage nommée "toto"
' ************************************************************
ActiveWorkbook.Names.Add Name:="toto", RefersToR1C1:= _
"='0845-0920'!" & Selection.Address(ReferenceStyle:=xlR1C1)
'
' Raz Picture présentes
' ************************************************************
Dim img As Shape
'
' Boucle de Raz
' ************************************************************
For Each img In Worksheets("0845-0920").Shapes
'
' Sélection des Pictures seules
' ************************************************************
If img.Name Like "Picture*" Then
img.Delete
End If
Next
'
' Suppression du fond orange de la colonne
' ************************************************************
Columns("T:T").Select
Selection.Interior.ColorIndex = xlNone
'
' Sélection de la plage choisie (toto)
' ************************************************************
Range("toto").Select
'
' Début de traitement des nouvelles images
' ************************************************************
'
' Initialisations
' ************************************************************
Saut = 0
HauteurGraph = 80
'
' Boucle de traitement de chaque ligne de la sélection
' ************************************************************
For Each c In Selection
'
' Test de présence d'une valeur
' ************************************************************
If c.Value <> "" Then
'
' Coloriage fond de la cellule (45 = orange)
' ************************************************************
With c.Interior
.ColorIndex = 45
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'
' Extraction du jour en format AAMMJJ
' ************************************************************
Datejour = c.Value
'
' Contrôle de la longueur de la date
' ************************************************************
If Len(Datejour) = 5 Then Datejour = "0" & Datejour
'
' Sélection du graphique dans le dossier "GRAPHIQUE" et affichage
' ************************************************************
Worksheets("0845-0920").Shapes.AddPicture "Macintosh HD:Users: ... :GRAPHIQUE:" _
& Datejour, True, True, PositionGraph + 10, (5 * c.RowHeight) + Saut, 200, HauteurGraph
-----> code à insérer ici après la dite selection
'
' Incrémentation de Saut
' ************************************************************
Saut = Saut + HauteurGraph + 5
End If
Next c |