Comment déplacer un graphique par macro sous excel 2010 ?

Résolu
VBACripteur Messages postés 4 Statut Membre -  
 VBACripteur -
Bonjour,

Depuis que je suis passé sous W7 Excel 2010 (j'étais sous XP excel 2003), le déplacement du graphique nommé strExtractNameGraph dans ma feuille ne fonctionne plus.
Que dois-je modifier pour que cela fonctionne ?

Ci dessous le code de la macro:

Sub CreationGraphL02()
'
' Sub CreationGraphL02
' SB le 11/04/2012
'
Dim lienGamme, strExtractNameGraph, strActiveWorkbookName, rep, rangeGamme, nameLigne As String
Dim sTxtLigne As String
Dim WorkbookSource As Workbook
Dim intLenNomGraph, intPosNomGraph, intFondCouleur As Integer
Dim i, j, test, intValue, intLen, intPos As Integer
Dim lngIndex As Long

'Permet d'atteindre la ligne "errorHandler" si une erreur survient.
On Error GoTo errorHandler

Application.ScreenUpdating = False

'***************** A MODIFIER SUIVANT LA LIGNE CONCERNEE *****************
lienGamme = "\\Frchantnas01a\Public\_Suivi Production Par lignes\Ligne 02\Technique\MP L02 - Gamme lub. - Régleur 2012.xls"
rangeGamme = "B5:M5,B21:M21"
sTxtLigne = "L02"
'*************************************************************************

nameLigne = "=""" & "" & sTxtLigne & """"

strActiveWorkbookName = ActiveWorkbook.Name

' Ouvrir le classeur source (en lecture seule (valeur True))
Set WorkbookSource = Workbooks.Open(lienGamme, False, True)

' réactiver le workbook
Workbooks(strActiveWorkbookName).Activate 'gérer l'erreur !

Charts.Add

ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=WorkbookSource.Sheets("RECAPIT ").Range(rangeGamme), PlotBy:=xlRows
ActiveChart.SeriesCollection(1).Name = nameLigne
ActiveChart.Location Where:=xlLocationAsObject, Name:="Feuil1"

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Résultats " & GetYear & " suivi gamme régleur " & sTxtLigne
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With

intLenNomGraph = Len(ActiveChart.Name)
intPosNomGraph = InStr(ActiveChart.Name, "Graphique")
strExtractNameGraph = Right(ActiveChart.Name, intLenNomGraph - intPosNomGraph + 1)

'***************** A MODIFIER SUIVANT LA LIGNE CONCERNEE *****************
' Positionnement du graphique
ActiveSheet.Shapes(strExtractNameGraph).IncrementLeft -171.75
ActiveSheet.Shapes(strExtractNameGraph).IncrementTop -100
'*************************************************************************

ActiveSheet.Shapes(strExtractNameGraph).ScaleWidth 0.65, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(strExtractNameGraph).ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft

ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select

'Compte le nombre de séries
For i = 1 To ActiveChart.SeriesCollection.Count
'compte le nombre de points
For j = 1 To ActiveChart.SeriesCollection(i).Points.Count
'teste la présente des étiquettes sur le graphs
If ActiveChart.SeriesCollection(i).Points(j).HasDataLabel = False Then test = 1
'affiche les étiquettes
ActiveChart.SeriesCollection(i).Points(j).HasDataLabel = True
'récupère les informations des étiquettes
rep = ActiveChart.SeriesCollection(i).Points(j).DataLabel.Text
intLen = Len(rep)
intPos = InStr(rep, "%")
If (intLen = intPos) Then
rep = Left(rep, intLen - 1)
Else
MsgBox ("Erreur de convertion n°1" & vbLf & _
"Vérifier les coordonnées des pourcentages à utiliser dans la gamme " & sTxtLigne & ".")
End If
'convertit l'étiquette en nombre et fais le test
If CDbl(rep) >= 90 Then
'suivant le résultat, change la couleur
ActiveChart.SeriesCollection(i).Points(j).Interior.ColorIndex = 4
Else
ActiveChart.SeriesCollection(i).Points(j).Interior.ColorIndex = 3
End If
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.Pattern = xlSolid
End With
'remets dans l'état initial le graphique
If test = 1 Then ActiveChart.SeriesCollection(i).Points(j).HasDataLabel = False
Next j
Next i

ActiveWindow.Visible = False
Windows(strActiveWorkbookName).Activate

WorkbookSource.Close False ' Fermer le classeur source sans enregistrer (False)
Set WorkbookSource = Nothing ' Libérer la ressource

Application.ScreenUpdating = True
Exit Sub

errorHandler:
'indique le numéro et la description de l'erreur survenue
MsgBox "Erreur n° " & Err.Number & ":" & vbLf & Err.Description
WorkbookSource.Close False ' Fermer le classeur source sans enregistrer (False)
Set WorkbookSource = Nothing ' Libérer la ressource

End Sub

8 réponses

  1. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Pour positionner ton graph ?
    Les "increment.. c'est ce que tu a avec l'éditeur de macro
        ActiveSheet.Shapes(strExtractNameGraph).Top = Range("C6").Top 
        ActiveSheet.Shapes(strExtractNameGraph).Left = Range("C6").Left

    Si ce n'est pas ça que tu cherche tu dis...
    A+

    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    NOTE : Je ne répond pas aux MP pour les questions techniques.
    0
  2. VBACripteur
     
    Bonjour lermite222,

    Les lignes suivantes en lieu et place des incréments

    ActiveSheet.Shapes(strExtractNameGraph).Top = Range("C6").Top
    ActiveSheet.Shapes(strExtractNameGraph).Left = Range("C6").Left

    ne fonctionnent pas non plus.

    Une autre idée ???
    0
  3. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Tu a quel erreur ?
    0
  4. VBACripteur
     
    C'est ce qui est étrange, je n'ai aucune erreur. C'est juste que le graph ne se déplace pas.
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    supprime le On Error. Pas de détection erreur dans une procédure qui fonctionne pas.

    0
  7. VBACripteur
     
    J'ai supprimé le "On Error GoTo errorHandler" et je n'ai toujours pas d'erreur.

    Tout les reste semble se dérouler correctement (excepté la mise à l'échelle mais comme ça ressemble au déplacement cela fonctionnera certainement une fois le pb de déplacement résolu).
    0
  8. VBACripteur
     
    Par contre, je ne vois pas bien pourquoi supprimer le "On Error GoTo errorHandler" puisque c'est lui qui me permet de gérer les erreurs ??? A moins que je me trompe...
    0
  9. VBACripteur
     
    Bonjour,

    J'ai enfin trouvé !
    En utilisant la sub suivante:

    Public Sub ScanGraph(lNbChart As Long)
    Dim shTemp As Worksheet
    Dim graphTemp As ChartObject

    For Each shTemp In ThisWorkbook.Sheets
    For Each graphTemp In shTemp.ChartObjects
    lNbChart = lNbChart + 1
    MsgBox ("Nom du graphique: " & graphTemp.Name)
    Next graphTemp
    Next shTemp

    Set shTemp = Nothing
    Set graphTemp = Nothing

    End Sub

    je me suis aperçu que j'avais 2 graphique qui portait le nom "Graphique 1" et celui qui était déplacé était celui que je ne voyais pas.

    Le sujet est donc clos.
    0