Bonjour,
Suite a une suggestion dans un autre fil de discussion, j'ai essayé d'enlever des ".Activate" dans mon code mais maintenant rien de va plus...
Voici mon code original qui fonctionnait
et voici le code que j'ai essayé de rendre plus beau, ou j'ai créé wb pour le Workbook dans lequel je vais travailler, sh pour la feuille et ch pour le graphique...
La ligne en rouge est celle où j'ai le type mismatch... quelqu'un peut m'aider?
Merci
Suite a une suggestion dans un autre fil de discussion, j'ai essayé d'enlever des ".Activate" dans mon code mais maintenant rien de va plus...
Voici mon code original qui fonctionnait
Code:
Public Function CreationGraphique()
'
' CreationGraph Macro
' Créée par Automation Mauricie Inc. (M-E Guay)
' 20/10/2009
'
Dim sFichier As String
Dim sDate As String
Dim sAnnee As String
Dim sMois As String
Dim sJour As String
Dim sPath As String
sPath = "C:\test\"
sDate = Date - 1
sAnnee = Year(sDate)
sMois = Month(sDate)
If Len(sMois) < 2 Then
sMois = "0" & sMois
End If
sJour = Day(sDate)
If Len(sJour) < 2 Then
sMois = "0" & sJour
End If
'Creation nom de fichiers
sFichier = Right(sAnnee, 2) & sMois & sJour & "_test"
sFichierNouv = Right(sAnnee, 2) & sMois & sJour & "Graph_test"
'Vérifie si fichier existe
If FileFolderExists(sPath & sFichier & ".xls") Then
'Ouvre fichier avec les données
Workbooks.Open Filename:=sPath & sFichier & ".csv"
'Renomme le fichier
ActiveWorkbook.SaveAs Filename:= _
sPath & sFichierNouv & ".xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
Workbooks(sFichierNouv & ".xls").Activate
ActiveWorkbook.CheckCompatibility = False
'Creation du graphique
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "Graphique"
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLines
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = sJour & "-" & sMois & "-" & sAnnee
'Ajout courbe 1
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "=""1"""
ActiveChart.SeriesCollection(1).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ActiveChart.SeriesCollection(1).Values = _
"='" & sFichier & "'!$C$7:$C$2000"
'Ajout courbe 2
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""2"""
ActiveChart.SeriesCollection(2).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ActiveChart.SeriesCollection(2).Values = _
"='" & sFichier & "'!$D$7:$D$2000"
'Ajout courbe 3
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""3"""
ActiveChart.SeriesCollection(3).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ActiveChart.SeriesCollection(3).Values = _
"='" & sFichier & "'!$E$7:$E$2000"
'Ajout courbe 4
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "=""4"""
ActiveChart.SeriesCollection(4).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ActiveChart.SeriesCollection(4).Values = _
"='" & sFichier & "'!$G$7:$G$2000"
Workbooks(sFichierNouv & ".xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
'Application.Quit
End If
End Functionet voici le code que j'ai essayé de rendre plus beau, ou j'ai créé wb pour le Workbook dans lequel je vais travailler, sh pour la feuille et ch pour le graphique...
Code:
Public Function CreationGraphique()
'
' CreationGraph Macro
' Créée par Automation Mauricie Inc. (M-E Guay)
' 20/10/2009
'
Dim sFichier As String
Dim sDate As String
Dim sAnnee As String
Dim sMois As String
Dim sJour As String
Dim sPath As String
Dim wb As Workbook
Dim sh As Worksheet
Dim ch As Chart
On Error GoTo Fin
sPath = "C:\test\"
sDate = Date - 1
sAnnee = Year(sDate)
sMois = Month(sDate)
If Len(sMois) < 2 Then
sMois = "0" & sMois
End If
sJour = Day(sDate)
If Len(sJour) < 2 Then
sMois = "0" & sJour
End If
'Creation nom de fichiers
sFichier = Right(sAnnee, 2) & sMois & sJour & "_test"
sFichierNouv = Right(sAnnee, 2) & sMois & sJour & "Graph_test"
'Vérifie si fichier existe
If FileFolderExists(sPath & sFichier & ".csv") Then
'Ouvre fichier avec les données
wb = Workbooks.Open(Filename:=sPath & sFichier & ".csv")
'Renomme le fichier
wb.SaveAs Filename:= _
sPath & sFichierNouv & ".xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
'Workbooks(sFichierNouv & ".xls").Activate
wb.CheckCompatibility = False
'Creation du graphique
sh = wb.Sheets.Add
sh.Name = "Graphique"
[COLOR="Red"] ch = sh.Shapes.AddChart.Select[/COLOR]
ch.ChartType = xlXYScatterSmoothNoMarkers
ch.HasTitle = True
ch.ChartTitle.Text = sJour & "-" & sMois & "-" & sAnnee
'Ajout courbe 1
ch.SeriesCollection.NewSeries
ch.SeriesCollection(1).Name = "=""1"""
ch.SeriesCollection(1).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ch.SeriesCollection(1).Values = _
"='" & sFichier & "'!$C$7:$C$2000"
'Ajout courbe 2
ch.SeriesCollection.NewSeries
ch.SeriesCollection(2).Name = "=""2"""
ch.SeriesCollection(2).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ch.SeriesCollection(2).Values = _
"='" & sFichier & "'!$D$7:$D$2000"
'Ajout courbe 3
ch.SeriesCollection.NewSeries
ch.SeriesCollection(3).Name = "=""3"""
ch.SeriesCollection(3).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ch.SeriesCollection(3).Values = _
"='" & sFichier & "'!$E$7:$E$2000"
'Ajout courbe 4
ch.SeriesCollection.NewSeries
ch.SeriesCollection(4).Name = "=""4"""
ch.SeriesCollection(4).XValues = _
"='" & sFichier & "'!$B$7:$B$2000"
ch.SeriesCollection(4).Values = _
"='" & sFichier & "'!$G$7:$G$2000"
wb.Save
wb.Close
Else
MsgBox ("Le fichier " & sFichier & "n'existe pas")
End If
Fin:
'Application.Quit
End FunctionLa ligne en rouge est celle où j'ai le type mismatch... quelqu'un peut m'aider?
Merci
