Probleme de declaration d'une plage pour un graph

Le 03/11/2013 à 00:24

Bonjour,

jJ'ouvre le fichier évolution des études1.xlsm pour lire des données dedans. A chaque ligne contenant le mot LULU" dans évolution des études1 onglet 2013, j'ajoute le nom du commanditaire dans la 1ere ligne et ainsi de suite. idem pour les autres promoteurs. Tout marche bien jusqu'au sub CreationGraph () avec LULU où je souhaite créer un graph d'après une plage de cellule qui provient de la feuille promoteur2.

1- je n'ai pas de message d'erreur lors du passage dans le sub creationgraph () sur ces 2 lignes mais je n'arrive pas à lire les valeurs en laissant la souris sur wss ou ws1 donc je ne sais pas si cela passe ?

Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom2")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Promoteur2")

2- je n'arrive pas à passer le cap de ces 2 lignes :

Set maplage = ws2.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(6, -Nb_Ligne2).adress)
Set MonGraphe = wss.ChartObjects.Add(horizontal, vertical, 500, 300) '(position x ds la feuille, position y dans la feuille, hauteur, largeur)
MonGraphe.Chart.SetSourceData maplage

merci beaucoup pour votre aide

jasserin

Option Explicit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Nb_Ligne1 As Integer
Dim Nb_Ligne2 As Integer
Dim Fichier  As String 'évolution des études
Dim Chemin As String '
Dim i As Integer
Dim j As Integer
Dim test As Boolean
Dim promoteur As String
Dim maplage As Range
Dim titre As String

Sub ouverture_fichier_évolutiondesétudes()
Fichier = "évolution des études.xlsm"
  Application.ScreenUpdating = False
  Chemin = "C:\users\utilisateur\Desktop" & Application.PathSeparator
  If Dir(Chemin & Fichier) = "" Then
    MsgBox "Fichier " & Fichier & " introuvable : Programme terminé"
    End
  End If
Workbooks.Open (Chemin & Fichier)
Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur1").Activate
Call LOREAL
Call LVMH
Call CHANEL
Call EUROTEST
Call DIVERS
End Sub

Sub LOREAL()
Dim nom As String

Set ws1 = Application.Workbooks("évolution des études.xlsm").Sheets("2013")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur2")
promoteur = "LULU"
Nb_Ligne1 = ws1.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

'tri par Lulu du classeur Evolution des études1 de la feuille 2013
For i = 18 To 20 'Nb_Ligne1
test = False
' inscription du premier nom
If ws1.Range("B" & i).Value = "LULU" Then
    If ws1.Range("C" & i).Value <> "" Then nom = ws1.Range("C" & i).Value
    Call nomexistedeja(nom, promoteur)

    If test = False Then

        If ws2.Range("A4").Value <> "" Then
            ws2.Range("A" & Nb_Ligne2 + 1).Value = nom
            ws2.Range("A" & Nb_Ligne2 + 1).Interior.ColorIndex = 22 'fond cellule fushia
        End If

        If ws2.Range("A4").Value = "" Then
            ws2.Range("A4").Value = nom
            ws2.Range("A4").Interior.ColorIndex = 22 'fond cellule fushia
        End If
    End If
End If

Next i
Call CreationGraph(promoteur)
End Sub

Sub LVMH()
Dim nom As String

Set ws1 = Application.Workbooks("évolution des études.xlsm").Sheets("2013")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur1")
promoteur = "TOTO"
Nb_Ligne1 = ws1.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

'tri par Lulu du classeur Evolution des études1 de la feuille 2013
For i = 18 To Nb_Ligne1
test = False
' inscription du premier nom
If ws1.Range("B" & i).Value = "TOTO" Then
    If ws1.Range("C" & i).Value <> "" Then nom = ws1.Range("C" & i).Value
    Call nomexistedeja(nom, promoteur)

    If test = False Then

        If ws2.Range("A4").Value <> "" Then
            ws2.Range("A" & Nb_Ligne2 + 1).Value = nom
            ws2.Range("A" & Nb_Ligne2 + 1).Interior.ColorIndex = 22 'fond cellule fushia
        End If

        If ws2.Range("A4").Value = "" Then
            ws2.Range("A4").Value = nom
            ws2.Range("A4").Interior.ColorIndex = 22 'fond cellule fushia
        End If
    End If
End If

Next i
Call CreationGraph(promoteur)
End Sub

Sub TITI()
Dim nom As String
promoteur = "TITI"

Set ws1 = Application.Workbooks("évolution des études.xlsm").Sheets("2013")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur4")
Nb_Ligne1 = ws1.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

'tri par Lulu du classeur Evolution des études1 de la feuille 2013
For i = 18 To Nb_Ligne1
test = False
' inscription du premier nom
If ws1.Range("B" & i).Value = "TITI" Then
    If ws1.Range("C" & i).Value <> "" Then nom = ws1.Range("C" & i).Value
    Call nomexistedeja(nom, promoteur)

    If test = False Then

        If ws2.Range("A4").Value <> "" Then
            ws2.Range("A" & Nb_Ligne2 + 1).Value = nom
            ws2.Range("A" & Nb_Ligne2 + 1).Interior.ColorIndex = 22 'fond cellule fushia
        End If

        If ws2.Range("A4").Value = "" Then
            ws2.Range("A4").Value = nom
            ws2.Range("A4").Interior.ColorIndex = 22 'fond cellule fushia
        End If
    End If
End If

Next i
Call CreationGraph(promoteur)
End Sub

Sub EURO()
Dim nom As String

Set ws1 = Application.Workbooks("évolution des études.xlsm").Sheets("2013")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur3")
promoteur = "EURO"
Nb_Ligne1 = ws1.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

'tri par Lulu du classeur Evolution des études1 de la feuille 2013
For i = 18 To Nb_Ligne1
test = False
' inscription du premier nom
If ws1.Range("B" & i).Value = "EURO" Then
    If ws1.Range("C" & i).Value <> "" Then nom = ws1.Range("C" & i).Value
    Call nomexistedeja(nom, promoteur)

    If test = False Then

        If ws2.Range("A4").Value <> "" Then
            ws2.Range("A" & Nb_Ligne2 + 1).Value = nom
            ws2.Range("A" & Nb_Ligne2 + 1).Interior.ColorIndex = 22 'fond cellule fushia
        End If

        If ws2.Range("A4").Value = "" Then
            ws2.Range("A4").Value = nom
            ws2.Range("A4").Interior.ColorIndex = 22 'fond cellule fushia
        End If
    End If
End If

Next i
Call CreationGraph(promoteur)
End Sub

Sub DIVERS()
Dim nom As String

Set ws1 = Application.Workbooks("évolution des études.xlsm").Sheets("2013")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("DIVERS")
promoteur = "DIVERS"
Nb_Ligne1 = ws1.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

'tri par Lulu du classeur Evolution des études1 de la feuille 2013
For i = 18 To Nb_Ligne1
test = False
' inscription du premier nom
If ws1.Range("B" & i).Value <> "LULU" _
And ws1.Range("B" & i).Value <> "TOTO" _
And ws1.Range("B" & i).Value <> "EURO" _
And ws1.Range("B" & i).Value <> "TITI" Then
    nom = ws1.Range("B" & i).Value
    Call nomexistedeja(nom, promoteur)

    If test = False Then

        If ws2.Range("A4").Value <> "" Then
            ws2.Range("A" & Nb_Ligne2 + 1).Value = nom
            ws2.Range("A" & Nb_Ligne2 + 1).Interior.ColorIndex = 22 'fond cellule fushia
        End If

        If ws2.Range("A4").Value = "" Then
            ws2.Range("A4").Value = nom
            ws2.Range("A4").Interior.ColorIndex = 22 'fond cellule fushia
        End If
    End If
End If

Next i
Call CreationGraph(promoteur)
End Sub

Sub nomexistedeja(nom, promoteur)
If promoteur = "LULU" Then Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur2")
If promoteur = "TOTO" Then Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur1")
If promoteur = "EURO" Then Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur3")
If promoteur = "TITI" Then Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur4")
If promoteur = "DIVERS" Then Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("DIVERS")

Nb_Ligne2 = ws2.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

For j = 1 To Nb_Ligne2
If nom = ws2.Range("A" & j).Value Then test = True
Next j
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For i = 1 To 500
If Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur1").Range("A" & i) = "" Then Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur1").Range("A" & i).Interior.ColorIndex = xlNone
If Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur2").Range("A" & i) = "" Then Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur2").Range("A" & i).Interior.ColorIndex = xlNone
If Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur3").Range("A" & i) = "" Then Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur3").Range("A" & i).Interior.ColorIndex = xlNone
If Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur4").Range("A" & i) = "" Then Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("Promoteur4").Range("A" & i).Interior.ColorIndex = xlNone
If Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("DIVERS").Range("A" & i) = "" Then Application.Workbooks("Suivi par commanditaire 2013.xlsm").Sheets("DIVERS").Range("A" & i).Interior.ColorIndex = xlNone
Next
End Sub

Public Sub CreationGraph(promoteur)
Dim horizontal As Integer
Dim vertical As Integer
Dim MonGraphe As Object
horizontal = 10
vertical = 50
Dim wss As Worksheet
Dim ws2 As Worksheet

If promoteur = "LULU" Then
Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom2")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Promoteur2")
titre = "Nb d'études - promoteur2 - " & ws2.Range("B2").Value
End If

If promoteur = "TOTO" Then
Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom1")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Promoteur1")
titre = "Nb d'études - promoteur1 - " & ws2.Range("B2").Value
End If

If promoteur = "EURO" Then
Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom3")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Promoteur3")
titre = "Nb d'études - promoteur3 - " & ws2.Range("B2").Value
End If

If promoteur = "TITI" Then
Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom4")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Promoteur4")
titre = "Nb d'études - promoteur4 - " & ws2.Range("B2").Value
End If

If promoteur = "DIVERS" Then
Set wss = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("Graphes Prom divers")
Set ws2 = Application.Workbooks("Suivi par commanditaire 2013.xlsm").Worksheets("DIVERS")
titre = "Nb d'études - promoteur divers - " & ws2.Range("B2").Value
End If

Nb_Ligne2 = ws2.Range("A" & Cells.Rows.Count).End(xlUp).Row 'compte dernière ligne remplie de A

Set maplage = ws2.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(6, -Nb_Ligne2).adress)
Set MonGraphe = wss.ChartObjects.Add(horizontal, vertical, 500, 300) '(position x ds la feuille, position y dans la feuille, hauteur, largeur)
MonGraphe.Chart.SetSourceData maplage

    With MonGraphe.Chart
        .HasTitle = True

       With .ChartTitle
          .Characters.Text = titre
       End With

    End With
End Sub
23evolution-des-etudes1.xlsm (8.97 Ko)
29suivi-par-commanditaire-20131.xlsm (103.77 Ko)
Le 03/11/2013 à 00:30

Bonsoir,

Avant d'aller plus moins; modifies:

Set maplage = ws2.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(6, -Nb_Ligne2).adress)

par

Set maplage = ws2.Range(ActiveCell, ActiveCell.Offset(6, -Nb_Ligne2).Address)

ou

Set maplage = ws2.Range(ActiveCell), ActiveCell.Offset(6, -Nb_Ligne2))

A te relire.

Cdlt

Le 03/11/2013 à 15:03

Bonjour,

merci pour le conseil mais malheureusement, cela ne change rien.

jasserin

Le 03/11/2013 à 15:38

Bonjour

J'ai regardé un peu tes fichiers et j'ai juste une question

Comment tu définis la plage ?

Tu te sers de ActiveCell alors que la page n'est pas active

Marques dans un message à quoi correspondrait la plage

Dans la feuille "promoteur2" tu as juste rajouté des données en colonne A (de A4 à A6) et tes formules en B4:G4 indiquent toutes #REF!

Rechercher des sujets similaires à "probleme declaration plage graph"