Range("A1").CurrentRegion.Select
ThisWorkbook.Charts.Add

Dim objChart As Chart, objRange As Range

    Set objRange = Worksheets("Feuil1").Range(Worksheets("Feuil1").Cells(1, 1), Worksheets("Feuil1").Cells(21, 3))
    Set objChart = ThisWorkbook.Charts.Add
    objChart.ChartType = xlXYScatter
    objChart.SetSourceData objRange, xlColumns

Dim objChart As Chart, objRange As Range

    Set objRange = Worksheets("Feuil1").Range(Worksheets("Feuil1").Cells(1, 1), Worksheets("Feuil1").Cells(21, 3))
    Set objChart = ThisWorkbook.Charts.Add
    objChart.ChartType = xlXYScatter
    objChart.SeriesCollection.Add objRange, xlColumns, True, True

Dim objChart As Chart, objRange As Range, MaSerie As Series, compteur As Long

    Set objRange = Worksheets("Feuil1").Range(Worksheets("Feuil1").Cells(1, 1), Worksheets("Feuil1").Cells(21, 3))
    Set objChart = ThisWorkbook.Charts.Add
    objChart.ChartType = xlXYScatter
    objChart.SeriesCollection.Add objRange, xlColumns, True, True
    For compteur = 2 To objRange.Columns.Count
        Set MaSerie = objChart.SeriesCollection.NewSeries
        MaSerie.Values = "=" & objRange.Columns(compteur).Address(True, True, xlR1C1, True)
        MaSerie.XValues = "=" & objRange.Columns(1).Address(True, True, xlR1C1, True)
    Next compteur

Public Sub CreationGraphe1()

    Dim MonGraphe As Chart, MaPlage As Range

    Set MaPlage = Worksheets("donnees").Range(Cells(2, 7), Cells(14, 12))
    Set MonGraphe = ThisWorkbook.Charts.Add
    MonGraphe.ChartType = xlColumnStacked100
    MonGraphe.SetSourceData MaPlage, xlColumns
With MonGraphe.SeriesCollection(5)
    .ChartType = xlXYScatterSmoothNoMarkers
    .AxisGroup = 2
     With .Border
         .Weight = xlMedium
         .LineStyle = xlAutomatic
         .ColorIndex = 4
     End With
End With
With MonGraphe
   .HasTitle = True
   With .ChartTitle
      .Characters.Text = "ANNEE 2001"
      .Shadow = True
      .Border.Weight = xlHairline
   End With
   With .Axes(xlValue, xlPrimary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Proportion"
   End With
   With .Axes(xlValue, xlSecondary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Total (hrs)"
   End With
End With

End Sub

ActiveChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 100#, 100#).Select 
Selection.Characters.Text = "Le Texte"

Sub ExportChart()
Dim FName As String, NomGraphe As String

NomGraphe = Right(ActiveChart.Name, Len(ActiveChart.Name) - Len(ActiveSheet.Name) - 1)
With ActiveSheet.ChartObjects(NomGraphe).Chart
    FName = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
    .Export Filename:=FName, FilterName:=TypeImg, Interactive:=True
End With
End Sub

Option Explicit

Private Const Fichier As String = "C:\ImageTemp.gif"
   
   
Sub ExporteGIF_GroupeGraphiques()
   Dim Sh As Shape
   Dim Tableau(1 To 4) As String
   Dim i As Integer, Nb As Integer
   
   'Supprime l'image temporaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
   
    'Boucle sur les 4 premiers graphiques de la feuille active
    For i = 1 To 4
        Tableau(i) = ActiveSheet.ChartObjects(i).Name
    Next
    
    'Regroupe les graphiques
    Set Sh = ActiveSheet.Shapes.Range(Tableau).Group

    
    'copie la forme
    Sh.CopyPicture
    'crée un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, _
                        Sh.Width, Sh.Height).Chart
        .Paste 'colle l'image dans graphique
        ' enregistre le graphique au format gif
        .Export Fichier, "GIF"
    End With
    
    Nb = ActiveSheet.ChartObjects.Count
    'supprime le graphique
    ActiveSheet.ChartObjects(Nb).Delete
    
    Sh.Ungroup
End Sub

Sub RemplaceGraphiqueParImage()
    With ActiveSheet
        .ChartObjects(1).CopyPicture
        .ChartObjects(1).Delete
        .Paste .Range("A1")
    End With
End Sub

ActiveSheet.ChartObjects(1).Name = "Le nom du Graphique"

Feuil1.chartObjects(2).Chart.printOut

Dim nomImage As String
Dim IE As Object
Dim Hauteur As Single, Largeur As Single

nomImage = "C:\imageTemp.gif"
'supprime l'image si elle existe déja
If Dir(nomImage) <> "" Then Kill nomImage
'--------------------

'---- création du graphique
Application.ScreenUpdating = False

Charts.Add
    With ActiveChart
        .ChartType = xlLineMarkers
        .SetSourceData Source:=Sheets("Feuil1").Range("A1:B5"), PlotBy:=xlColumns
        .Location Where:=xlLocationAsObject, Name:="Feuil1"
    End With
 
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "le graphique"
        .HasLegend = True
        .Legend.Position = xlLegendPositionRight
    End With
    
ActiveChart.Export nomImage, "GIF" 'export du graphique au format image

Hauteur = Feuil1.ChartObjects(Feuil1.ChartObjects.Count).Height * 1.8
Largeur = Feuil1.ChartObjects(Feuil1.ChartObjects.Count).Width * 1.6
Sheets("Feuil1").ChartObjects(Sheets("Feuil1").ChartObjects.Count).Delete

Application.ScreenUpdating = True
'--------------------

'creation d'une fenêtre internet explorer pour visualiser l'image du graphique
Set IE = CreateObject("InternetExplorer.application")
IE.navigate "about:blank"

IE.document.Title = "mon graphique"
IE.addressbar = False
IE.MenuBar = False
IE.StatusBar = False
IE.Toolbar = False
IE.Width = Largeur
IE.Height = Hauteur
IE.Left = 120

IE.document.body.innerHTML = "<html><IMG SRC='" & nomImage & "'</html>"

IE.Visible = True

Option Explicit

Private Const Fichier As String = "C:\ImageTemp.gif"

Private Sub UserForm_Initialize()
   
   'Supprime l'image temportaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
   
    'Définit le 1er graphique de la Feuil1
    'exporte le graphique au format image
    Worksheets("Feuil1").ChartObjects(1). _
        Chart.Export Filename:=Fichier, filtername:="GIF"
    'Affiche l'image dans l'UserForm
    Image1.Picture = LoadPicture(Fichier)
End Sub

Private Sub UserForm_Terminate()
   'Supprime l'image temporaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
End Sub

Private Sub CommandButton1_Click() 
    Dim i As Integer 
    Dim S1 As Object 
    Dim TabX(10), TabY(10) 
    'Utilisez l'objet WCChart pour la bibliothèque OWC9.
    'Dim Cht As WCChart
    'Utilisez l'objet ChChart dans les bibliothèques OWC10(Office 2002) et OWC11(Office 2003). 
    Dim Cht As ChChart 
    Dim C As Object 
    
    Randomize 
    
    'Remplissage des tableaux qui serviront à créer le graphique 
    For i = 0 To 9 
        TabX(i) = i 
        TabY(i) = Int((50 * Rnd) + 1) 
    Next i 
    
    Set C = ChartSpace1.Constants 
    Set Cht = ChartSpace1.Charts.Add 
    
    With Cht 
        'Type de graphique 
        .Type = C.chChartTypeScatterLineMarkers 
        .HasLegend = True 
        .Legend.Position = C.chLegendPositionBottom 
    End With 
    
     Set S1 = Cht.SeriesCollection.Add 
         With S1 
              .Caption = "Nom de la série" 
              .Type = C.chChartTypeLine 
              .SetData C.chDimCategories, C.chDataLiteral, TabX 
                  .SetData C.chDimValues, C.chDataLiteral, TabY 
         End With 
    
End Sub

 
Private Sub CommandButton1_Click()
    Dim j As Byte, i As Byte
    Dim Ch As Chart
    
    'Recherche les onglets graphiques
    For Each Ch In Charts
            Debug.Print "Feuille graphique " & vbTab & Ch.Name
    Next Ch
    
    'Boucle sur tous les onglets du classeur
    For j = 1 To Sheets.Count
         'Recherche les graphiques incorporés dans la feuille
        For i = 1 To Sheets(j).ChartObjects.Count
            Debug.Print "Nom: " & Sheets(j).ChartObjects(i).Name & vbTab & _
            " dans " & Sheets(j).Name
        Next i
    Next j
End Sub

  
	Dim Grph As ChartObject 
	
    On Error Resume Next 
    Set Grph = Sheets("Feuil2").ChartObjects("Graphique 1") 
    If Not Grph Is Nothing Then MsgBox "Le graphique existe"

Sub creationGraphiqueParTableau()
    Dim i As Byte
    Dim Tableau(1 To 10) As Integer, Tableau2(1 To 10) As Integer
    
    'Création du tableau pour les Abscisses
    For i = 1 To 10
        Tableau(i) = i * 2
    Next i
    
    'Création d'un tableau pour les Ordonnées
    For i = 1 To 10
        'Le tableau est rempli par des valeurs aléatoires pour
        'cet exemple
        Tableau2(i) = Int((50 * Rnd) + 1)
    Next i
    
    'Création graphique
    Charts.Add
    'Définit la localisation du graphique:
    'dans la feuille de calcul Feuil1 pour cet exemple
    ActiveChart.Location _
    Where:=xlLocationAsObject, Name:="Feuil1"
    
    'Ajoute une série dans le graphique
    With ActiveChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = Tableau() 'Abscisses
        .SeriesCollection(1).Values = Tableau2() 'Ordonnées
        'Définit le type (Courbe)
        .ChartType = xlLine
    End With
End Sub

Sub ImageGraphiqueDansCommentaire_CelluleA1()
    Dim nomImage As String
    Dim Grph As ChartObject
    Dim Hauteur As Single, Largeur As Single

    nomImage = "C:\imageTemp.gif"
    
    'Définit le 1er graphique dans la Feuil1
    Set Grph = Feuil1.ChartObjects(1)
    'Exporte le graphique au format image GIF
    Grph.Chart.Export nomImage, "GIF"
    
    'récupère la dimension du graphique pour l'appliquer au commentaire
    Hauteur = Grph.Height
    Largeur = Grph.Width

    'Vérifie s'il existe déja un commentaire dans la cellule A1
    'et le supprime si c'est le cas
    If Not Feuil1.Range("A1").Comment Is Nothing Then _
        Feuil1.Range("A1").Comment.Delete
    
    'Creation du nouveau commentaire dans la cellule A1
    With Feuil1.Range("A1")
        .AddComment
        .Comment.Visible = False
        'Définit la hauteur du commentaire
        'le graphique
        .Comment.Shape.Height = Hauteur
        'Définit la largeur du commentaire
        .Comment.Shape.Width = Largeur
        'Insère l'image dans le commentaire
        .Comment.Shape.Fill.UserPicture nomImage
    End With
    
    'Supprime l'image exportée
    Kill nomImage
    
    'Supprime le graphique
    Grph.Delete
End Sub

'Définit un type d'affichage spécifique pour la 1ere série du graphique 
'xlLine = Courbe  
Feuil1.ChartObjects(1).Chart.SeriesCollection(1).ChartType = xlLine

Sub extractionValeursOrdonnees_Series()
    Dim Cible As ChartObject
    Dim i As Integer, j As Integer
    
    'Définit le 1er graphique de la Feuil1
    Set Cible = Feuil1.ChartObjects(1)
    
    'Boucle sur toutes les séries du graphique
    For j = 1 To Cible.Chart.SeriesCollection.Count
        
        'Récupère le nom de la série
        Debug.Print Cible.Chart.SeriesCollection(j).Name & ":"
        
        'boucle sur tous les points de la série
        For i = 1 To Cible.Chart.SeriesCollection(j).Points.Count
        
            With Cible.Chart.SeriesCollection(j).Points(i)
                'Affiche les étiquettes
                .HasDataLabel = True
                'Extrait la valeur du point
                Debug.Print .DataLabel.Characters.Text
                'Masque les étiquettes
                .HasDataLabel = False
            End With
        
        Next i
        
    Debug.Print "----"
    Next j
End Sub

Sub extractionDonneesGraphique()
    Dim Ch As Chart
    Dim J As Integer
    Dim X As Integer
    
    'Définit le premier graphique de la Feuil1:
    Set Ch = Worksheets("Feuil1").ChartObjects(1).Chart
    'Compte le nombre de données
    J = UBound(Ch.SeriesCollection(1).Values)
    
    Worksheets("Feuil2").Cells(1, 1) = "Abscisses"
    
    'Ecrit les données d'abscisses dans la Feuil2.
    With Worksheets("Feuil2")
        .Range(.Cells(2, 1), .Cells(J + 1, 1)) = _
            Application.Transpose(Ch.SeriesCollection(1).XValues)
    End With
    
    'Boucle sur les sériee du graphique et écrit les valeurs d'ordonnées à
    'la suite dans la Feuil2.
    For X = 1 To Ch.SeriesCollection.Count
        'Extrait le nom de la série
        Worksheets("Feuil2").Cells(1, X + 1) = Ch.SeriesCollection(X).Name
        
        With Worksheets("Feuil2")
            .Range(.Cells(2, X + 1), .Cells(J + 1, X + 1)) = _
                Application.Transpose(Ch.SeriesCollection(X).Values)
        End With
    Next
End Sub

Sub afficherEvolutionPourcentage_enFonctionDuPointPrecedent()
    'Remarque : les labels ne seront pas mis à jour automatiquement
    'si les données sont modifiées dans le tableau
    Dim j As Integer
    Dim X As Single, Y As Single
    Dim Resultat As String
    Dim Grph As ChartObject
    
    'Définit le graphique cible dans la Feuil1
    Set Grph = Feuil1.ChartObjects(1)
    
    On Error Resume Next
        'suppression des Labels existants dans la 1ere série
        Grph.Chart.SeriesCollection(1).DataLabels.Delete
    On Error GoTo 0
    
    'affiche les Labels (Ordonnées) de la 1ere série
    'pour en extraire les valeurs
    Grph.Chart.SeriesCollection(1).ApplyDataLabels _
            Type:=xlDataLabelsShowValue
    
    'boucle sur les point de la 1ere serie (en dehors du premier point)
    For j = 2 To Grph.Chart.SeriesCollection(1).Points.Count
        
        X = Grph.Chart.SeriesCollection(1).Points(j). _
                DataLabel.Characters.Text 'valeur du point
        Y = Grph.Chart.SeriesCollection(1).Points(j - 1). _
                DataLabel.Characters.Text 'valeur du point précédent
        
        'Insère le pourcentage pour chaque point de la série.
        'Cette ligne est placée avant la ligne
        '"Resultat = Format((X / Y) - 1, "0.00%")" et permet ainsi
        'de ne rien afficher pour le 1er point.
        Grph.Chart.SeriesCollection(1).Points(j - 1). _
                DataLabel.Characters.Text = Resultat
        
        'calcul le pourcentage entre les 2 points
        Resultat = Format((X / Y) - 1, "0.00%")
    Next j
    
    'Affiche le pourcentage pour le dernier point de la série
    Grph.Chart.SeriesCollection(1).Points(j - 1).DataLabel. _
            Characters.Text = Resultat

    'Mise en forme des étiquettes
    With Grph.Chart.SeriesCollection(1).DataLabels
            .Font.ColorIndex = 5 'couleur bleue
            .Position = xlLabelPositionAbove 'position au dessus du point
            .Orientation = xlUpward 'orientation verticale (vers le haut)
    End With

End Sub

Feuil1.ChartObjects(2).Chart.PrintOut

 
Charts("Graph1").PrintOut

 
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Dim Ch As Chart
    
    'Boucle sur la collection de feuilles graphiques    
    For Each Ch In Charts
        If Ch.Name = Sh.Name Then Application.CutCopyMode = False
    Next Ch
End Sub

  
Private Sub Chart_Deactivate()
   Application.CutCopyMode = False
End Sub

 
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:= "Logarithmique"

 
Option Explicit

Sub Test()
    Dim Cible As String
    
    Cible = TraductionGraphPersoTypeName("Line - Column on 2 Axes")
    
    MsgBox Cible
    If Cible = "" Then Exit Sub
    
    ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:=Cible
 
End Sub



Function TraductionGraphPersoTypeName(strTypeName As String) As String
    Dim TabEnglish As Variant
    Dim TabFrench As Variant
    Dim TabRecherche As Variant
    Dim Verif() As String
    Dim i As Integer

    'Extraction de XL8galry.xls / Excel 2002
        'Dim Wb As Workbook
        'Dim Cht As Chart
        
        'Set Wb = Workbooks("XL8GALRY.XLS")
        'For Each Cht In Wb.Charts
            'Debug.Print Cht.Name
        'Next
    
    'Tableau TypeName en français
    TabFrench = Array("Barres texturées", "Logarithmique", "Histogramme - Aires", _
        "Courbes à deux axes", "Courbe - Histo. 2 axes", "Courbes - Histogramme", _
        "Courbe avec lissage", "Cônes", "Pastels", "Tubes", "Secteurs éclatés", _
        "Couleurs empilées", "Histogramme en relief", "Secteurs bleus", _
        "Barres flottantes", "Courbes en couleurs", "Histogramme n&b", _
        "Courbes n&b - chrono.", "Aires n&b", "Secteurs n&b")
    
    'Tableau TypeName en anglais
    TabEnglish = Array("Outdoor Bars", "Logarithmic", "Column - Area", _
        "Lines on 2 Axes", "Line - Column on 2 Axes", "Line - Column", _
        "Smooth Lines", "Cones", "Area Blocks", "Tubes", "Pie Explosion", _
        "Stack of Colors", "Columns with Depth", "Blue Pie", "Floating Bars", _
        "Colored Lines", "b&w Column", "b&w Line - Timescale", "b&w Area", _
        "b&w Pie")

    
    'Vérifie la version de pays Excel
    Select Case Application.International(xlCountryCode)
        
        '-----------------------------------------------
        Case 33: 'French
            'Vérifie si l'argument strTypeName est déja en français
            Verif = Filter(TabFrench, strTypeName, True)
            If UBound(Verif) <> -1 Then
                TraductionGraphPersoTypeName = Verif(0)
                Exit Function
            End If
            
            'Recherche l'équivalence française
            For i = 0 To UBound(TabEnglish)
                If TabEnglish(i) = strTypeName Then
                    TraductionGraphPersoTypeName = TabFrench(i)
                    Exit Function
                End If
            Next i

        '-----------------------------------------------
        'Case 49: 'German
        
        
        '-----------------------------------------------
        Case Else: 'US English (renvoie 1) ou
                   'US English as the default language (case else)
            
            ''Vérifie si l'argument strTypeName est déja en anglais
            Verif = Filter(TabEnglish, strTypeName, True)
            If UBound(Verif) <> -1 Then
                TraductionGraphPersoTypeName = Verif(0)
                Exit Function
            End If
            
            'Recherche l'équivalence anglaise
            For i = 0 To UBound(TabFrench)
                If TabFrench(i) = strTypeName Then
                    TraductionGraphPersoTypeName = TabEnglish(i)
                    Exit Function
                End If
            Next i
    End Select
End Function

Sub PositionGraphique()
Dim objCht As ChartObject

'Définit le premier graphique dans la feuille
Set objCht = Feuil1.ChartObjects(1)

MsgBox objCht.TopLeftCell.Address & ":" & objCht.BottomRightCell.Address
End Sub

Sub RepositionneGraphique()
    Dim Emplacement As Range
    Dim Grph As ChartObject
     
    'Définit le premier graphique de la feuille
    Set Grph = Feuil1.ChartObjects(1)
    'Définit la plage de cellule pour positionner le grpahique
    Set Emplacement = Range("D3:J20")
        
    With Grph
        .Left = Emplacement.Left
        .Top = Emplacement.Top
        .Height = Emplacement.Height
        .Width = Emplacement.Width
    End With
End Sub

 
Sub SuppressionToutesSeries()
    Dim W As Worksheet
    Dim NBSeries As Integer, I As Integer
    
    'Le graphique est dans la première feuille du classeur
    Set W = ThisWorkbook.Worksheets(1)
    W.ChartObjects(1).Activate
    
NBSeries = ActiveChart.SeriesCollection.Count
    
ActiveChart.DisplayBlanksAs = xlZero
    'Equivalent de:
        'Menu Options
        'onglet Graphique
        'sélection de l'option "valeur zero"
    'boucle sur les séries afin de les supprimer
    For I = NBSeries To 1 Step -1
        ActiveChart.SeriesCollection(I).Delete
    Next I
 
    'Adaptez la réinitialisation en fonction de la valeur par défaut
    'dans le menu d'Options.
    ActiveChart.DisplayBlanksAs = xlNotPlotted
End Sub