Sujet Précédent Sujet Suivant

Prob graphique Excel depuis VB 6.0

cs_phpboy Messages postés 2 Date d'inscription mardi 29 juin 2004 Statut Membre Dernière intervention 13 juillet 2004 - 13 juil. 2004 à 00:02
cs_phpboy Messages postés 2 Date d'inscription mardi 29 juin 2004 Statut Membre Dernière intervention 13 juillet 2004 - 13 juil. 2004 à 00:05
J'ai un problème après la création d'un graphique : Excel reste ouvert en arrière plan. J'ai cherché mais pas trouvé de solutions.
Merci d'avance

JC

Voici la procédure :

Public Sub Export_Excel(My_Listview As ListView, Nbr_Colonnes As Integer, ouvrir)

If ouvrir <> "" Then


Progression (0) 'Barre de progression

'Déclarations
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set XlSheet = xlBook.Worksheets(1)

Dim LigneExcel As Integer
Dim ColExcel As Integer
Dim LigneListView As Integer
Dim compt As Integer
Dim comptcol As Integer

LigneExcel = 1
ColExcel = 1

'Permet d'eviter gros bug
LigneListView = LigneExcel - 1

'Rendre invisible EXCEL
xlApp.Visible = False

'Désactive les messages d'Excel
xlApp.Application.DisplayAlerts = False

'Activation de xlBook
xlBook.Activate

'Calcul du nombre de décimal pour séparateur de millier
If nbVirgule <> 0 Then
Dim formatVirgule As String
formatVirgule = "#,##0."
For k = 1 To nbVirgule
formatVirgule = formatVirgule & "0"
Next
End If

'Affecter les données de la listbox dans les cellules de la feuille
With XlSheet

'Insertion des infos principales
.Cells(1, 9) = "Nombre d'acheteurs :"
.Cells(1, 10) = n

.Cells(2, 9) = "Quantité en vente :"
.Cells(2, 10) = q

.Cells(3, 9) = "Quantité minimum :"
.Cells(3, 10) = qm

.Cells(4, 9) = "Prix minimum :"
.Cells(4, 10) = pm

.Cells(5, 9) = "Prix du marché :"
.Cells(5, 10) = Round(p, nbVirgule)

'Mise en gras et séparateur de milliers
.Range("I1:I5").Font.Bold = True
If nbVirgule <> 0 Then
.Range("J2:J5").NumberFormat = formatVirgule
End If


'Progression (10) 'Barre de progression

'Insere le nom des entetes de colonnes
For comptcol = 0 To Nbr_Colonnes - 1
.Cells(LigneExcel, ColExcel) = My_Listview.ColumnHeaders(comptcol + 1)
ColExcel = ColExcel + 1

'Barre de progression
'Progression ((comptcol / (Nbr_Colonnes - 1)) * 5) + 10
Next comptcol

ColExcel = 1
LigneExcel = LigneExcel + 1

'Inscrire le contenu d'une listview dans la feuille 1 d'un classeur EXCEL
For compt = 0 To My_Listview.ListItems.Count - 1

'On boucle sur les colonnes
For comptcol = 0 To Nbr_Colonnes - 1
'Si première colonne de la listview
If comptcol = 0 Then

'Affectation à la cellule de la valeur en cours
.Cells(LigneExcel, ColExcel) = CDbl(My_Listview.ListItems.Item(LigneExcel - LigneListView - 1))

'Les autres colonnes de la listview
Else

'Affectation à la cellule de la valeur en cours
.Cells(LigneExcel, ColExcel) = CDbl(My_Listview.ListItems.Item(LigneExcel - LigneListView - 1).ListSubItems(comptcol))

'Séparateur des milliers
If (.Cells(LigneExcel, ColExcel) <> 0) And (nbVirgule <> 0) Then
.Cells(LigneExcel, ColExcel).NumberFormat = formatVirgule
End If

End If
ColExcel = ColExcel + 1
Next comptcol

ColExcel = 1
LigneExcel = LigneExcel + 1

'Barre de progression
Progression ((compt / (My_Listview.ListItems.Count - 1)) * 100)

Next compt

'Pour mettre l'entête des colonnes en gras
.Range("A" & LigneListView + 1 & ":" & Chr(65 + Nbr_Colonnes - 1) & LigneListView + 1).Font.Bold = True

'Pour ajuster les colonnes
.Range("A:" & Chr(65 + Nbr_Colonnes - 1 + 3)).Columns.AutoFit

End With

'-- GRAPHIQUE -------------------------------------------------------------------------------
'With xlGraphe
' .ChartType = xlPie
' .Name = "Allocations"
' .SetSourceData Source:=Sheets("Feuil1").Range("D2:D" & LigneExcel - 1)
' .SeriesCollection(1).XValues = "=Feuil1!R2C1:R" & LigneExcel - 1 & "C1"
' .SeriesCollection(1).Values = "=Feuil1!R2C4:R" & LigneExcel - 1 & "C4"
' .SeriesCollection(1).Name = "=Feuil1!R1C4"
' .Location Where:=xlLocationAsObject, Name:="Feuil1"
' '.HasLegend = False
' '.ApplyDataLabels AutoText:=True, LegendKey:=False, _
' 'HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:=True, _
' 'ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
'End With
'--------------------------------------------------------------------------------------------

'-- GRAPHIQUE -------------------------------------------------------------------------------
'Ajout d'un graphique
Dim xlGraphe As Chart

xlGraphe.Add

With xlGraphe
'Type du graphe
.ChartType = xlPie

'Sources
.SetSourceData Source:=Sheets("Feuil1").Range("D2:D" & LigneExcel - 1) _
, PlotBy:=xlColumns

'Nouvelle série
.SeriesCollection.NewSeries

'Titres de la séries
.SeriesCollection(1).XValues = "=Feuil1!R2C1:R" & LigneExcel - 1 & "C1"

'Données de la série
.SeriesCollection(1).Values = "=Feuil1!R2C4:R" & LigneExcel - 1 & "C4"

'Titre du graphique
.SeriesCollection(1).Name = "=Feuil1!R1C4"

'Location du graphique
.Location Where:=xlLocationAsObject, Name:="Feuil1"
End With
'--------------------------------------------------------------------------------------------

'Enregistrement du fichier EXCEL
XlSheet.SaveAs (ouvrir)

'On ferme tout pour éviter les erreurs qui sont assez Zarb
xlBook.Close
xlApp.Quit

'Supprime les objets
Set xlApp = Nothing
Set xlBook = Nothing
Set XlSheet = Nothing
Set xlGraphe = Nothing

'Barre de progression
Progression (0)
End If
End Sub

1 réponse

Réponse 1 / 1
cs_phpboy Messages postés 2 Date d'inscription mardi 29 juin 2004 Statut Membre Dernière intervention 13 juillet 2004
13 juil. 2004 à 00:05
Désolé si tout ce code vous effraie, mais comme je ne sais d'ou viens l'erreur.....

La partie ou je crée le graph est en bas

Merci
JC
0

Discussions similaires

Remplir un formulaire PDF à partir di'un fichier excel
bgame -
the_little_big_man -

3 réponses
tracer courbe en langage C
rin01 -
Ibebel -

5 réponses
EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
**** Différence entre VB et VBA***********
EMSIEN -
CanisLupus -

3 réponses
Rejoignez-nous