Code aléatoire !!

Question

Bonjour

Je crée des graphiques sous VBA à partir d'ACCESS pour les afficher sur Excel.
J'exporte ma requête sur une feuille Excel et je mets mon graphique en forme par VBA.
Mon problème c'est que cette mise en forme est tout à fait aléatoire.
En effet elle ne se fait pas à chaque fois.
Tout à l'heure c'était presque une fois sur 2 et maintenant c'est plus du tout.
Je vous montre mon code pour que vous m'aidiez parce que là je vais devenir fou.

WkExcel.Sheets("Graphes").Cells(1, 1).Value = ""
WkExcel.Charts.Add
WkExcel.ActiveChart.ChartType = xlLine
    
WkExcel.ActiveChart.SetSourceData Source:=WkExcel.Sheets("Graphes").Cells, PlotBy:= _
        xlColumns
WkExcel.ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Histo"
    With WkExcel.ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = titre
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Semaines"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nombre de supports"
    End With
    WkExcel.ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False

WkExcel.ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
    With Selection
           .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 44
        .Fill.BackColor.SchemeColor = 36
    End With
WkExcel.ActiveChart.SeriesCollection(3).Select
    With Selection.Border
        .ColorIndex = 5
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With
WkExcel.ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .ColorIndex = 3
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
  
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With
    WkExcel.ActiveChart.SeriesCollection(2).Select
    With Selection.Border
        .ColorIndex = 4
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection

        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With

SVP aidez moi car ca devient super urgent !!

Merci

Tuning Max · Answer

Et en mode Debug, lorsque tu fait pas à pas est ce que ça marche? Pas de message d'erreurs?

tedparker · Answer

Il passe bien sur chaque ligne de mon code et sélectionne bien les courbes mais ne les mets pas en page.
En fait, maintenant, quand j'ouvre ACCESS je peux le faire une fois et ca marche très bien mais seulement une fois.Les fois suivantes la mise en page ne se fait pas.
Si je ferme et rouvre ACCESS alors c'est bon mais encore seulement pour une fois.
Je remets le code complet du bouton et je vous indique à partir de quel endroit les mises en forme ne se font plus:

Private Sub Commande22_Click()


Dim FileExists As Boolean
On Error Resume Next
FileExists ((GetAttr("Y:	emp.xls") And vbDirectory) 0)
If FileExists = True Then
    Kill ("Y:	emp.xls")
End If


Dim bd As Database
Set bd = CurrentDb
Dim rs_req As Recordset
Dim reqSQL As String


reqSQL = "SELECT DISTINCT Prev.NomSem, Sum(Prev.Equivalent_prev) AS Prévisions, Sum(Reel.Equivalent_reel) AS Réel, Capacite.Capacite AS [Capacité du Site]"
reqSQL reqSQL & " FROM Capacite INNER JOIN (Prev INNER JOIN Reel ON (Prev.NomSem Reel.Nom_Sem) AND (Prev.NumSite = Reel.NumSite) AND (Prev.NumRayon = Reel.NumRayon)) ON (Capacite.NumSite = Reel.NumSite) AND (Capacite.NomSem = Reel.Nom_Sem)"
reqSQL = reqSQL & " GROUP BY Prev.NomSem, Capacite.Capacite;"


If (IsObject("ReqComp")) Then
DoCmd.DeleteObject acQuery, "ReqComp"
End If
Dim qd As QueryDef
Set qd = bd.CreateQueryDef("ReqComp", reqSQL)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "ReqComp", "Y:\Temp.xls"
DoCmd.DeleteObject acQuery, "ReqComp"


Dim Xl As Excel.Application
Dim XL2 As Excel.Application
Dim WkExcel As Excel.Workbook
Dim wk2 As Excel.Workbook
Set Xl = New Excel.Application
Set XL2 = New Excel.Application
Xl.Visible = True
XL2.Visible = True
Set WkExcel = Xl.Workbooks.Add
Set wk2 = XL2.Workbooks.Open("Y:\Temp.xls")
wk2.Sheets("ReqComp").Activate
WkExcel.Sheets.Add.Name = "Graphes"

Dim i As Long
Dim j As Long
Dim titre As String
If (Me.num_rayon.Value = "") Then
titre = "Comparatif des semaines " & Me.ladatedeb & " à " & Me.ladatefin & Chr(13) & "pour le site " & Me.num_site.Value
Else
titre = "Comparatif des semaines " & Me.ladatedeb & " à " & Me.ladatefin & Chr(13) & "pour le site " & Me.num_site.Value & Chr(13) & "pour le rayon " & Me.num_rayon.Value
End If
Dim compt As Long
compt = 1

While wk2.Sheets("ReqComp").Cells(compt, 1).Value <> ""
compt = compt + 1
Wend

For i = 1 To compt
For j = 1 To 5
WkExcel.Sheets("Graphes").Cells(i, j).Value = wk2.Sheets("ReqComp").Cells(i, j).Value
Next
Next


wk2.Close
XL2.Quit
Set XL2 = Nothing

WkExcel.Sheets("Graphes").Cells(1, 1).Value = ""
WkExcel.Charts.Add
WkExcel.Charts(1).Activate
WkExcel.ActiveChart.ChartType = xlLine
    
WkExcel.ActiveChart.SetSourceData Source:=WkExcel.Sheets("Graphes").Cells, PlotBy:= _
        xlColumns
WkExcel.ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Histo"
WkExcel.ActiveChart.HasTitle = True
WkExcel.ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
    With WkExcel.ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = titre
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Semaines"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nombre de supports"
    End With
   

With WkExcel.ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = False
        .HasMinorGridlines = False
    End With
    With WkExcel.ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
'A partir d'ici la mise en forme ne se fait plus même si la sélection des éléments se fait bien
    WkExcel.ActiveChart.SeriesCollection(3).Select
  
    With Selection.Border
        .ColorIndex = 4
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With
    WkExcel.ActiveChart.SeriesCollection(2).Select
    With Selection.Border
        .ColorIndex = 41
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With
    WkExcel.ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .ColorIndex = 3
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
    End With
    WkExcel.ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
    With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 44
        .Fill.BackColor.SchemeColor = 36
    End With


Dim RetVal As Variant
On Error Resume Next
RetVal = Shell("Taskkill /IM Excel.exe /F", 0)

End Sub


Voila mon gros souci
SVP aidez-moi because c'est pour le boulot et jdois finir assez vite
Merci

Tuning Max · Answer

Alors voilà, après avoir cherché un moment (désolé mais ton code manque d'explication) je me suis permis de le modifier légèrement. 
Je l'ai testé chez moi et ça semble marcher toujours de la même manière. Pour ce que j'ai put constater en tout cas, mais je ne sais pas quelle mise en forme du graphique tu souhaite faire.
Juste une chose, je n'ai pas trop compris pourquoi tu fais deux classeurs plutôt que d'utiliser celui déjà ouvert et le modifier. Ca complique drolement l'operation


******************************** Start ****************************************
Private Sub Commande22_Click()
On Error GoTo Err_traitement
Dim FileExists As Boolean, qd As querydef, bd As Database, rs_req As Recordset
Dim reqSQL As String, Xl As Excel.Application, WkExcel As Excel.Workbook
Dim WkExcel As Workbook, RetVal As Variant
Dim i As Long, j As Long, titre As String

' test existance du fichier pour suppression
    FileExists ((GetAttr("Y:	emp.xls") And vbDirectory) 0)
If FileExists = True Then
    Kill ("Y:	emp.xls")
End If

' export des données de la base Access vers un fichier Excel
Set bd = CurrentDb

reqSQL = "SELECT DISTINCT Prev.NomSem, Sum(Prev.Equivalent_prev) AS Prévisions, Sum(Reel.Equivalent_reel) AS Réel, Capacite.Capacite AS [Capacité du Site]" & _
         " FROM Capacite INNER JOIN (Prev INNER JOIN Reel ON (Prev.NomSem Reel.Nom_Sem) AND (Prev.NumSite Reel.NumSite) AND (Prev.NumRayon = Reel.NumRayon)) ON (Capacite.NumSite = Reel.NumSite) AND (Capacite.NomSem = Reel.Nom_Sem)" & _
         " GROUP BY Prev.NomSem, Capacite.Capacite;"


If (IsObject("ReqComp")) Then
DoCmd.DeleteObject acQuery, "ReqComp"
End If
Set qd = bd.CreateQueryDef("ReqComp", reqSQL)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "ReqComp", "Y:\Temp.xls"
DoCmd.DeleteObject acQuery, "ReqComp"

'Ouverture et retraitement du fichier Excel
Set Xl = New Excel.Application
Xl.Visible = True
Set WkExcel = Xl.Workbooks.Open("Y:\Temp.xls")
WkExcel.Sheets("ReqComp").Activate

' definition du titre du graphique pour la variable titre
    Set WkExcel = ActiveWorkbook
   If (Me.num_rayon.Value = "") Then
       titre = "Comparatif des semaines " & Me.ladatedeb & " à " & Me.ladatefin & Chr(13) & "pour le site " & Me.num_site.Value
   Else
    titre = "Comparatif des semaines "
   End If

' création d'une feuille Graphique nomé Graphes     WkExcel.Sheets.Add.Name = "Graphes"
With WkExcel
            .Sheets("ReqComp").Name = "Graphes"
            .Sheets.Add Type:=xlChart, Count:=1, after:=Sheets(1)
End With
With WkExcel.ActiveChart
                .SetSourceData Source:=WkExcel.Sheets("Graphes").Cells, PlotBy:=xlColumns
                .Location Where:=xlLocationAsNewSheet, Name:="Histo"
                .HasTitle = True
                .ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
                .HasTitle = True
                .ChartTitle.Characters.Text = titre
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Semaines"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nombre de supports"
                .Axes(xlCategory).HasMajorGridlines = False
                .Axes(xlCategory).HasMinorGridlines = False
                .Axes(xlValue).HasMajorGridlines = True
                .Axes(xlValue).HasMinorGridlines = False
                .SeriesCollection(3).Select
End With
'A partir d'ici la mise en forme ne se fait plus même si la sélection des éléments se fait bien
With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
End With
With Selection.Border
        .ColorIndex = 4
        .Weight = xlThick
        .LineStyle = xlContinuous
End With

WkExcel.ActiveChart.SeriesCollection(2).Select
With Selection.Border
        .ColorIndex = 41
        .Weight = xlThick
        .LineStyle = xlContinuous
End With
With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
End With

WkExcel.ActiveChart.SeriesCollection(1).Select

With Selection.Border
        .ColorIndex = 3
        .Weight = xlThick
        .LineStyle = xlContinuous
End With

With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 3
        .Shadow = False
End With

WkExcel.ActiveChart.PlotArea.Select

With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
End With

Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1

With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 44
        .Fill.BackColor.SchemeColor = 36
End With

Exit Sub

Err_traitement:
'MsgBox Err.Description
Resume Next
'RetVal = Shell("Taskkill /IM Excel.exe /F", 0)
End Sub

Code aléatoire !!

3 réponses

Discussions similaires