Création de graphique et dimensionnement dans une boucle Do While

Guillaume45

XLDnaute Nouveau
Bonsoir à tous,

Je poste ici ma première demande sur le forum, aussi je tâcherai d'être le plus clair possible.

Je commence à acquérir de bonnes notions de VBA et d'avoir une réelle passion pour la programmation...mais cette passion vacille car je n'arrive pas à faire quelque chose et je commence à m'arracher les cheveux :)

Mon problème est le suivant :

J'ai une boucle dans laquelle je crée plusieurs tableaux que je trie ensuite par ordre croissant selon un critères spécifique. Jusqu'ici tout va bien cela fonctionne à merveille.

Le hic c'est quand je souhaite crée des graphiques basés sur ces tableaux et que je souhaite les positionner à un endroit précis du classeur. J'arrive à créer les graphiques et à les convertir en image mais je n'arrive pas à positionner ces images.

Je compte utiliser ce type de méthode mais ça ne fonctionne pas les images sont décalées, le résultat n'est absolument pas celui escompté !

hauteur = 34.5

.Height = 150
.Top = hauteur
.Left = 300
.Width = 400

hauteur = hauteur + 150

Mon idéal serait de dimensionner l'image comme la plage de cellules Range("A2:D10") et de placer l'image dans cette plage.

Please aidez moi je suis perdu je n'arrive vraiment pas à voir ce que j'ai mal fait !!

Merci de votre aide !

Bonne soirée.

Guillaume
 

Guillaume45

XLDnaute Nouveau
Re : Création de graphique et dimensionnement dans une boucle Do While

Bonjour Dranreb,

Merci pour votre réponse !

J'utilise le code suivant :

Range("R4").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "='Analyse mensuelle'!$B$2"
ActiveChart.SeriesCollection(1).Values = "='Analyse mensuelle'!$C$2:$P$2"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "='Analyse mensuelle'!$B$6"
ActiveChart.SeriesCollection(2).Values = "='Analyse mensuelle'!$C$6:$P$6"
ActiveChart.SeriesCollection(2).XValues = "='Analyse mensuelle'!$C$1:$P$1"
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = 0.65
ActiveChart.Axes(xlValue).MaximumScale = 1.05
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(1).Select
ActiveChart.SeriesCollection(1).Select
With Selection
.MarkerStyle = 1
.MarkerSize = 5
End With
Selection.MarkerStyle = 2
ActiveChart.SeriesCollection(1).Smooth = True

ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
ActiveChart.Parent.Delete
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= _
False, DisplayAsIcon:=False

Range("C" & i & ":I" & i + 4).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.ClearContents

ActiveSheet.Shapes.Range(Array("Picture " & num)).Select

With Selection
.Top = Range("C" & i & ":I" & i + 4).Top
.Height = Range("C" & i & ":I" & i + 4).Height
.Width = Range("C" & i & ":I" & i + 4).Width
.Left = Range("C" & i & ":I" & i + 4).Left
End With

Avec ce code ça ne fonctionne pas...je ne comprends pas les graphiques ne se placent pas correctement.

Voyez-vous où ça cloche ?

Merci de votre aide.

Cdt,

Guillaume
 

Dranreb

XLDnaute Barbatruc
Re : Création de graphique et dimensionnement dans une boucle Do While

Bonjour
N'utilisez pas les Select.
Préférez affecter les expressions par des Set à des variables objets de types appropriés
VB:
Dim Rg As Range, Sh As Shape
Set Rg = ActiveSheet.Range("C" & i & ":I" & i + 4)
Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
Sh.Top = Rg.Top ' Etc.
Enfin... dans ce style quoi...
À +
 

Guillaume45

XLDnaute Nouveau
Re : Création de graphique et dimensionnement dans une boucle Do While

J'ai utilisé le code suivant :

Set plage = ActiveSheet.Range("C" & i & ":I" & i + 4)
Set img = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

img.Select

Selection.ShapeRange.LockAspectRatio = msoFalse
img.Top = plage.Top
img.Height = plage.Height
img.Left = plage.Left
img.Width = plage.Width

Et voici le résultat obtenu :

Pb macro.jpg

Comme vous pouvez le voir les tableaux ne se placent pas correctement (ils devraient se siteur dans les zones marrons).

Voyez-vous d'où le problème pourrait venir ?

Merci.

Guillaume
 

Guillaume45

XLDnaute Nouveau
Re : Création de graphique et dimensionnement dans une boucle Do While

Voici deux fichiers pour vous aider :

1) Créez un répertoire 2012 dans votre dossier C:\.
2) Copiez les deux fichiers dedans.
3) Ouvrez le fichier " Fichier pour Excel Download ".
4) Cliquez sur le bouton " Synthèse globale " et choisissez l'année 2012 et le type "Par gestionnaire".
5) Dans la inputbox, saisissez 0,95.
6) L'outil va créer dans le dossier C:\2012 un fichier " Classement des fournisseurs MP (2012) ".

C'est ce fichier qui ne présente pas la mise en forme souhaité. Pour des raisons de confidentialité j'ai retiré beaucoup d'informations dans mon fichier mais normalement vous devriez pouvoir y voir clair avec ces infos (n'hésitez pas à me le redire si ce n'est pas le cas).

Merci de votre aide !

Guillaume
 

Pièces jointes

  • Fichier pour Excel Download.xlsm
    150.6 KB · Affichages: 45
  • Synthèse mensuelle par gestionnaire (MP) - 2012.xlsx
    27.1 KB · Affichages: 40

Dranreb

XLDnaute Barbatruc
Re : Création de graphique et dimensionnement dans une boucle Do While

Je n'ai pas pu exécuter parce que je n'ai pas Excel 2010.
Et d'ailleurs je ne veux pas me créer des répertoires.
Essayez de supprimer tous les Select
Écrivez comme ceci avant vos affectation de Top etc.:
VB:
img.LockAspectRatio = msoFalse
Stop
Mettez des espions puis déroulez en pas à pas pour voir qu'est ce qui est déplacé exactement et si les propriétés sont bien affectées.
À +
 

Guillaume45

XLDnaute Nouveau
Re : Création de graphique et dimensionnement dans une boucle Do While

Bonjour Dranreb !

J'ai trouvé le problème...j'avais dans ma macro une ligne " ActiveWindow.Zoom = 70 " que j'ai retiré...et ça fonctionne à merveille !

Merci encore pour votre aide.

A+

Guillaume
 

Discussions similaires

Réponses
6
Affichages
310

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 182
dernier inscrit
moutassim.amine