eside
XLDnaute Nouveau
Bonjour,
Je vous expose un peu mon problème. Je possede des graphiques sur une page que j'aimerais bien pouvoir repositionner, redimensionner pour qu'ils se trouvent par 6 sur une page A4 en format portrait. J'ai déjà créé une subroutine qui va les grouper par 6 (ou moins s'il y en a moins de 6) et les placer sur une page A4. Pour celà je récupère la taille de la page grâce aux saut de page (voir code ci-dessous).
Tout marche bien lorsque je le fait pas à pas grâce au debugger mais lorsque tout s'effectue d'une traite, les graphiques ne sont pas du tout à la bonne taille (en fait ils sont beaucoup plus grand). Tout à l'air de bien se dérouler jusqu'à la dernière boucle for.
J'ai même essayé de mettre un sleep avant le redimensionnement mais rien n'y a fait, j'en fait donc appel à vous et vos idées quelles qu'elles soient
Je vous expose un peu mon problème. Je possede des graphiques sur une page que j'aimerais bien pouvoir repositionner, redimensionner pour qu'ils se trouvent par 6 sur une page A4 en format portrait. J'ai déjà créé une subroutine qui va les grouper par 6 (ou moins s'il y en a moins de 6) et les placer sur une page A4. Pour celà je récupère la taille de la page grâce aux saut de page (voir code ci-dessous).
Tout marche bien lorsque je le fait pas à pas grâce au debugger mais lorsque tout s'effectue d'une traite, les graphiques ne sont pas du tout à la bonne taille (en fait ils sont beaucoup plus grand). Tout à l'air de bien se dérouler jusqu'à la dernière boucle for.
J'ai même essayé de mettre un sleep avant le redimensionnement mais rien n'y a fait, j'en fait donc appel à vous et vos idées quelles qu'elles soient
Code:
Sub tri_graphe()
Dim ch As ChartObject
Dim Grap As String
Dim Hauteur As Long
Dim Largeur As Long
Dim X As Long
Dim Y As Long
Dim graphe_count As Integer
X = 0
Y = 0
graph_count = 0
largeur_page = 0
hauteur_page = 0
'La variable count nous permet de replacer différement un graphique sur deux
Count = 0
For Each ch In ActiveSheet.ChartObjects
Grap = ch.Name
Hauteur = ActiveSheet.Shapes(Grap).Height
Largeur = ActiveSheet.Shapes(Grap).Width
'On test si on est en fin de groupe de 2
If Count = 1 Then
ActiveSheet.Shapes(Grap).Left = Y 'redéfinir position dans feuille
ActiveSheet.Shapes(Grap).Top = X 'redéfinir position dans feuille
X = X + Hauteur + 0
Y = 0
Else
ActiveSheet.Shapes(Grap).Left = Y 'redéfinir position dans feuille
ActiveSheet.Shapes(Grap).Top = X 'redéfinir position dans feuille
Y = Y + Largeur
End If
'On incrémente le compteur
If Count = 1 Then
Count = 0
Else
Count = Count + 1
End If
graph_count = graph_count + 1
Next ch
Sheets(2).Select
arrondi_nbre_graphique = Application.WorksheetFunction.RoundDown(graph_count / 6, 0)
j = 0
Do While j < arrondi_nbre_graphique
ActiveSheet.Shapes.Range(Evaluate("transpose(ROW(" & (j * 6) + 1 & ":" & (j * 6) + 6 & "))")).Select
Selection.ShapeRange.Group.Select
graph_count = graph_count - 6
j = j + 1
Loop
If graph_count <> 0 Then
ActiveSheet.Shapes.Range(Evaluate("transpose(ROW(" & j + 1 & ":" & j + graph_count & "))")).Select
Selection.ShapeRange.Group.Select
j = j + 1
End If
Dim nbre_groupe As Integer
nbre_groupe = j
ActiveSheet.PageSetup.Orientation = xlPortrait
ActiveSheet.PageSetup.PaperSize = xlPaperA4
ActiveSheet.PageSetup.CenterHorizontally = True
CibleV = ActiveSheet.VPageBreaks(1).Location.Column - 1 ' nombre de colonnes dans la 1ere page
CibleH = ActiveSheet.HPageBreaks(1).Location.Row - 1 ' nombre de ligne dans la 1ere page
For i = 1 To CibleV
largeur_page = largeur_page + Cells(1, i).Width ' calcul largeur premiere page imprimable
Next i
For i = 1 To CibleH
hauteur_page = hauteur_page + Cells(i, 1).Height ' calcul largeur premiere page imprimable
Next i
Do While hauteur_page = 0
Loop
Do While largeur_page = 0
Loop
For i = 1 To (nbre_groupe)
With ActiveSheet.Shapes(i)
.Width = largeur_page
.Height = hauteur_page
.Top = 0
End With
Next i
End Sub