mon prog a un ptit bug...

Question

bonjour,
j ai recup un prog qui permet de faire un graphe ss excel et de le transferer dans
VB.Ca fonctionne jusqu a l&acute;apparition du graphe ds le presse papier, mais il ne
le renvoie pas dans mon image VB. Je joints le programme.Si vous avez des
suggestions....Merci d&acute;avance.Thomas
 
Option Explicit
Sub CreationGraphiqueR&#233;ponses()
    'Cr&#233;e le graphique pour la revue &#233;dit&#233;e dans la fenetre Principale
    '-Statistique des r&#233;ponses renseign&#233;es
    Dim Langue As String
    Dim AmortissementAir, AmortissementAzote, i As Integer
    Dim xlApp, xlSheet, xlGraph As Object
    
    'Mise &#224; jour de l'indicateur graphique
    'Principale.Graphique = "CreationGraphiqueR&#233;ponses"
    On Error GoTo Fin<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" />


    Screen.MousePointer = vbHourglass
    'Informe "Ouverture de Excel", "Excel openning"
    'Calcul des donn&#233;es n&#233;cessaires au graphique
    AmortissementAir = Bilan.AmortAir.Text
    AmortissementAzote = Bilan.AmortAzote.Text
    'Ouverture d'une instance d'Excel
    Set xlApp = CreateObject("Excel.Application")


    'Excel travaille en arri&#232;re-plan
    xlApp.Visible = True
    xlApp.DisplayAlerts = True 'Pas de message intempestifs au moment de la fermeture
    'Ajout d'un classeur
    xlApp.Workbooks.Add
    'Ajout d 'une feuille dans le classeur
    Set xlSheet = xlApp.Workbooks(1).Sheets(1)


    'Informe "Cr&#233;ation du graphique", "Preparation of the chart"
    'Ecriture des l&#233;gendes n&#233;cessaires au graphique
    'Langue = Principale.ComboLangueLogiciel.Text
    xlSheet.Range("A1").Select
    If Langue = "Fran&#231;ais" Then
        xlSheet.Range("A1").FormulaR1C1 = "Amortissement"     
    Else
        xlSheet.Range("A1").FormulaR1C1 = "Amortissement"
    End If


    xlSheet.Range("B1").FormulaR1C1 = Str(AmortissementAir)


    xlSheet.Range("C1").FormulaR1C1 = Str(AmortissementAzote)
    'Ajout d'un graphique
    xlApp.Charts.Add after:=xlApp.Worksheets("Feuil1")


    With xlApp.ActiveChart


        .ChartType = 54 'xl3DPieExploded


        .SetSourceData Source:=xlSheet.Range("A1:C8"), PlotBy:=8 ' _


            'xlColumns


        '.Location Where:=2, Name:="Graph1" 'xlLocationAsObject


        '.HasTitle = False


        .ApplyDataLabels Type:=5, LegendKey:=False, _


            HasLeaderLines:=True 'xlDataLabelsShowValue
        'Suppression du rectangle gris
        .PlotArea.Select
        xlApp.Selection.ClearFormats
        'Grossissement de la police de la l&#233;gende
        .Legend.Select


        xlApp.Selection.AutoScaleFont = True


        With xlApp.Selection.Font


            .Name = "Arial"


            .FontStyle = "Normal"


            .Size = 14


        End With
        'D&#233;placement de la l&#233;gende
        xlApp.Selection.Left = 540


 


        'Grossissement de la police des &#233;tiquettes
        .SeriesCollection(1).DataLabels.Select
        xlApp.Selection.AutoScaleFont = True
        With xlApp.Selection.Font
            .Name = "Arial"


            .FontStyle = "Normal"


            .Size = 14


        End With
        'Copie le graphique dans le presse-papier
        xlApp.ActiveChart.ChartArea.CopyPicture


    End With
    'R&#233;cup&#233;ration du graphique dans l'image via le Presse-Papier
    exemple.Image1.Picture = Clipboard.GetData(3)

voilhes · Answer

Je viens de faire le test. Si ton graphique appara&#238;t bien sous Excel et qu'il est s&#233;lectionn&#233;:

ActiveChart.ChartArea.Copy

Sous VB, j'ai mis une PictureBox:

Picture1.Picture = Clipboard.GetData

-Francis-

Mon prog a un ptit bug...

1 réponse

Discussions similaires