Discussion :

[Pur2000]

Bonjour,

Voici mon projet :
Je souhaite regrouper sur une feuille de calcul des graphes qui ont été tracés sur des pages différentes. J'ai un code qui fonctionne mais sont défaut est d'être sensible à la résolution de l'écran sur lequel on travail. J'aimerais donc pouvoir redimensionner les graphes en les alignant sur les cellules et pas en fonction des pixels de mon affichage. Voici une partie de mon code actuel :

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
    For i = 1 To n 'n est le nb total de graph et i le graph en cours
        Sheets(CStr(Workbooks(Fichier_macro).Sheets("save").Cells(10 + i, 1))).Select
        ActiveChart.Location Where:=xlLocationAsObject, Name:=Nom_f_regroup
 
        If i = 1 Then
            graphhaut = ActiveSheet.Shapes("Graphique " & CStr(i)).Height
            graphlarg = ActiveSheet.Shapes("Graphique " & CStr(i)).Width
        End If
 
        If Round(i / 2, 0) * 2 = i Then
            ActiveSheet.Shapes("Graphique " & CStr(i)).IncrementLeft graphlarg / 2
            ActiveSheet.Shapes("Graphique " & CStr(i)).IncrementTop (-graphhaut / 2 + (i / 2 - 1) * graphhaut)
        Else
            ActiveSheet.Shapes("Graphique " & CStr(i)).IncrementLeft -graphlarg / 2
            ActiveSheet.Shapes("Graphique " & CStr(i)).IncrementTop (-graphhaut / 2 + (i / 2 - 0.5) * graphhaut)
        End If
    Next i

Ceci n'est peut être pas très parlant car c'est surement pas très propre et parce que ce code est appelé par un autre.

Ce que je souhaiterais faire c'est que le premier graphe que je rapatrie sur la feuille de calcul se trouve sur les cellules A1 à F16, le deuxième sur les cellules G1 à L16, le troisième sur les cellules A17 à F32, le quatrième sur les cellules G17 à L32 et ainsi de suite... Mais je ne sais pas comment faire.
J'aurais pu contacter EDF mais je pense que vous êtes plus à même de m'éclairer sur ce problème.

Merci pour votre aide,
A+

Pur2000

[SilkyRoad]

bonjour

Cet exemple suppose que tous les graphiques sont déjà transferés dans la feuille active :

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
Dim Ws As Worksheet
Dim i As Integer
Dim x As Integer, y As Integer
 
Application.ScreenUpdating = False
 
'La feuille qui va contenir les graphiques
Set Ws = ActiveSheet
 
For i = 1 To Ws.ChartObjects.Count
    If i Mod 2 = 0 Then
        x = 7
    Else
        x = 1
        y = (16 * ((i + 1) / 2)) - 15
    End If
 
    With Ws.ChartObjects(i)
        .Left = Ws.Range(Ws.Cells(y, x), Ws.Cells(y + 15, x + 5)).Left
        .Top = Ws.Range(Ws.Cells(y, x), Ws.Cells(y + 15, x + 5)).Top
        .Width = Ws.Range(Ws.Cells(y, x), Ws.Cells(y + 15, x + 5)).Width
        .Height = Ws.Range(Ws.Cells(y, x), Ws.Cells(y + 15, x + 5)).Height
    End With
Next i
 
Application.ScreenUpdating = True

bonne journée
michel

[DidierLoche]

Bonjour,

As-tu essayé ceci ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
largeur = Range("A1:F16").Width
hauteur = Range("A1:F16").Height
For i = 1 To 4
    If Application.WorksheetFunction.Odd(i) = i Then
        pos_hori = 0
    Else
        pos_hori = largeur
    End If
    pos_vert = Int((i - 1) / 2) * hauteur
    ActiveSheet.Shapes(i).Left = pos_hori
    ActiveSheet.Shapes(i).Top = pos_vert
    ActiveSheet.Shapes(i).Width = largeur
    ActiveSheet.Shapes(i).Height = hauteur
Next i

ça a l'air de donner ce que tu demandes
Bon dimanche,

Didier

[Pur2000]

Merci à vous, je viens de découvrir les méthodes Top et Left et je suis arrivé à programmer quelque chose proche de ce que vous proposez. Je vais quand même jeter un œil à vos codes. Merci pour votre aide.

[Pur2000]

Voici le résultat final en m'inspirant de vos codes.

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
 
Dim Ws As Worksheet
Dim i As Integer
Dim graphhaut As Single
Dim graphlarg As Single
 
graphlarg = Range("A1:F16").Width
graphhaut = Range("A1:F16").Height
 
Application.ScreenUpdating = False
 
'La feuille qui va contenir les graphiques
Set Ws = ActiveSheet
 
For i = 1 To Ws.ChartObjects.Count
 
    With Ws.ChartObjects(i)
        .Left = ((i + 1) Mod 2) * graphlarg 'Mod renvoie le reste c-a-d 7 Mod 2 =1 (Mod 2 ne peut renvoyer que 0 ou 1)
        .Top = Int((i - 1) / 2) * graphhaut
        .Width = graphlarg 
        .Height = graphhaut
    End With
Next i
 
Application.ScreenUpdating = True

Merci (j'ai encore appris de nouvelles choses !)
A+
Pur2000