[resolu] transformation tableau excel => graphique a l'aide de macros

dsl

heu ton deuxieme tableau a avoir quoi avec ton premier tableau et ton probleme?

La solution est assistant graphique histograme

en fait si on m'explique comment mettre un fichier sur le forum vous aurez une meilleure vue sur mon probleme

On ne peut pas mettre de fichiers sur le forum.
Il existe des sites dédiés sur lesquels tu peux déposer tes fichiers.
Tu peux alors mettre un lien vers ces fichiers dans ton sujet.

/!\ Attention cependant. Un fichier Excel peut contenir des macros, ne pas télécharger puis exécuter un tel fichier sans précaution.

Hoegarden31» La prochaine fois que tu fais un up d'une demi-heure, je sévis, quelque soit l'urgence du problème.

et comment on cree un lien ?
(dsl mais je suis vraiment tres nul )

sur le site dedié a l'hebergement il te donnera le lien pour ton fichier et apres tu le colle dans ton message

ok merci

Voilà un UP déguisé, tout à fait légitime  

expired

Ah, voilà un bel avatar !   ( De toutes les bières belges, ta préférée c'est la hou-gaaar-deun ? )

Oui c ma préférée (pour simple info je suis belge lol )
Sinon quelqu'un a une proposition pour moi ?
(je vous dit aussi que je cherche aussi
au cas ou il y en a qui croient que j'attent juste la reponse )

Argggh, KangOl, un Flamin !
Moi, une de mes préférées, c'est la Queue de charrue brune. Elle a un nom français, mais elle est flamande quand même (Ploegsteert).

Ton lien ne marche pas chez moi  

SVP expliquez moi alors comment avoir un lien ?(quel bon site faut-il utiliser ?

http://www.archive-host.com/

voici le fichier :
http://anonyme.archive-host.com/projectoverview2007_5ot...

Ok je vois le problème déjà c'est pas un graphique mais du coloriage de cellules...

Tu dois avoir une barre par ligne du tableau ?
Quel est le lien entre les valeurs "00.00" et le compteur de semaine ? C'est le code couleur des PH PR ?

oui en fait ce sont des projet et les valeurs indiquent la date de fin du projet
ex : 07.03 c le projet PRO dont la phase 0 fini la 3eme semaine de l'annee 2007 donc normallement, je dois colorier les casses du 6.26 jusqu'au 7.03 inclus
se que je voudrai faire est :
je prend la valeur dans la tableau a gauche et je recherche la meme valeur dans le tableau de droite puis je colorie cette casse.
apres je colorie toutes les casses avant jusqu'a ce qu'il y a une autre couleur

petite precision : je veux que les valeurs sur fond vert (PR0, PR1, PR2, PR3, PR4)
le reste je m'en fiche

Alors voilà comment il faut que tu procèdes : (enfin mon avis)

Créer un module de paramétrage où tu vas renseigné les paramètres que tu peux pas retrouver automatiquement sous forme de constante.

- Première ligne utile : 9
- Ligne année : 7
- ligne semaine : 8
- Colonne début graph : M (alias 19)
- Colonne PR0 : E en numérique 5
- Colonne PR4 : I en numérique 9

Ensuite il te faut les fonctions suivantes :

GetPosition : fonction qui calcule pour une date donnée "aa.ss" le numéro de la colonne correspondante dans ton graphique
GetCharacter : fonction qui renvoie pour un numéro de 1 à 256 la colonne excel correspondante (par exemple 1 => A, M=> 19 etc.
SetColor : procedure qui pour une cellule donnée (ex:"A1") colorie la cellule selon le code couleur donnée

Ensuite le programme principal :

Tu détermine la taille de ton tableau de projet : tu te base sur la colonne B et tu trouve la dernière ligne remplie.
Tu détermine ta colonne max dans le graphique : tu te base sur la ligne 7 et tu trouve la colonne max (valeur numérique)

Tu parcours ton tableau projet pour chaque ligne
Tu parcours les colonnes de date
Si la date est remplie : tu calcules la position de la colonne à remplir et tu garde en mémoire la position (il te faut une date actuelle et une précedente.)
Si date prec et date act sont renseignées
Tu colorie du début à la fin -1 (d'où le fait de stocker du numérique)
date precedente devient date act


Voilà en gros par contre il faut que tu empeche que 2 phase de projet commence en meme temps comme sur ta ligne 2 de ton tableau "07.16" Car soit il s'agit d'une date de début soit de fin de phase mais pas un mix des deux.

Essaie d'avancer en commencent par les fonctions utiles que j'ai mis testes les biens pour être certaine qu'elle fonctionne puis une fois que tu as toutes les pièces tu assembles  
bon courage

ok merci pour cet aide.
pour ce qui est de la ligne 2, je suis en train de faire un prog qui teste le tableau comme sa pas de probleme
Sinon il va falloir expliquer certains trucs comme :

Créer un module de paramétrage

déterminer la taille du tableau de projet

Freeman23 tu cois que sa marche pour colorier les casses avec autofill ?

Créer un module de paramétrage : Facon de parler

Tu créé un module appelé general par exemple.
Tu déclare tes constantes à l'interieur

Public const K_PREM_LIGNE = 9

déterminer la taille du tableau de projet :

Sujet débattu avec Zeb il y a quelques temps
Pour une ligne (B étant la colonne de test) :

range("B" & 65536).end(xlUp).row

Pour une colonne : (i étant la ligne de test)

range("IV" & i).end(xltoLeft).column

le XltoLeft à vérifier...

c bon le XltoLeft marche tres bien merci

Pour remplir une cellule il faut passer par :

range("A1").interior.Color = 255 ' Rouge code :RGB : FF0000

ok merci comme je suis tres nul en VBA,
dite moi si c juste c debut :

Public Const K_FIRST_LINE = 9

Public Const LINE_YEAR = 7

Public Const LINE_WEEK = 8

 
 
Function GetPosition()

Dim a, i

For i = K_FIRST_LINE To 48

    a = Range("E" & i).End(xlUp)

 
    Next i

End Function

j'enlever le

.Row

pour recuperer la valeur qui est ecrit dans le tableau
merci
petite precision : sa fait 1 semaine que j'ai commencer avec le langage VBA donc aidez moi pls  

Je pense que tu n'as pas saisie l'utiliité du End

En fait il s'agit de déterminer la position de ta dernière ligne ou de ta dernière colonne contenant des données, donc ta limite à 48 n'a pas lieu d'être.

Public const K_DEB_GRAPH = 19 'Colonne M

 
Function GetPosition(dtdate as string) as long 

Dim a  as variant

Dim i   as long

Dim max as long 

Dim sem as long 

Dim an   as long 

 
getposition = -1

max = .range("IV" & LINE_YEAR).End(xlUp).column 'renvoie la dernière colonne contenant des données de date du graphique

' On sépare la date 

an = left(dtdate,instr(dtdate,".")-1) '7

sem = mid(dtdate,instr(dtdate,".")+1) ' 12

For i = K_DEB_GRAPH To max

    if cells(LINE_YEAR,i) = an then 

       if cells(LINE_WEEK,i) = sem then 

            ' on a trouvé la colonne voulue

            Getposition = i 

       end if 

    end if       

Next i

End Function

ok merci
juste pour info la colonne "M" n'est pas 19 en numerique mais 13
je peux me tromper mais la lettre M est la 13 eme lettre de l'alphabet

Dans l'alphabet latin, oui. Mais en grec ?

je sais pas et puis je m'en fiche car j'ai tester
avec la date qui est dans la colonne "M" est avec 19 il la trouve pas
donc j'en deduits que la valeur 19 correspond a la colonne "S"

un autre question :
quand on a une colonne en numerique,
comment le remettre en lettre
merci
ex :
19 ->S ?

En VB (Tu es au bon endroit pour poser la question) ou en Excel (devine quoi, c'est pas ici qu'on traite des logiciels bureautique   ) ?

Donc en VBA, on utilise les fonctions Asc et Chr.
Asc("A"), c'est la valeur ASCII de A, soit 65.
est donc le numéro de la lettre dans l'alphabet.

Dans l'autre sens:

Lettre2NumCol = Lettre2NumCol * ....
NumCol2Lettre = NumCol2Lettre & ....

  Tu nous proposes du code récursif ?!

lol merci kiki29 sa marche trop bien
1000x merci

>> Zeb : rectifications faites : tu es d'une vigilance sans failles

quelqu'un peut m'expliquer comment on recupere le numero de colonne de la casse seclectionner

non c bon j'ai trouver une solution qui marche :

d = Left(Application.ActiveCell.Column, 2)

maintenant, il faut que je recupere la ligne de la casse selectionner
avec quelle commande ?

Je t'ai déjà montré la solution pour ces deux questions si tu prenais le temps de lire l'aide pour toutes les fonctions et propriétés. Quand tu as une cellule selectionnée avec Selection  , Range ou Cells il suffit d'utiliser row ou column.

Selection.row

Range("B1").column

Cells(10,3).row

ok merci par contre j'utilise plus 'Selection' sinon zeb n'est pas content
 

De la casse ? De la case ? Sous Excel, on parle de cellule  

devrait faire l'affaire.

Sinon, réflechir et se servir de l'aide d'Excel.

EDIT: Je viens de me faire griller d'une bonne demi-heure  

Ah mais ça dépend, cher Hougardène,

Select/Selection est dans 99% des cas une infamie.
Surtout le Select. Quel besoin de déplacer la sélection ?

Si en revanche tu cherches à savoir quelle feuille, quelle cellule l'utilisateur a sélectionnées, ce qui peut être très utile, il est légitime d'utiliser Selection.

en fait je cherche a colorier des cellules apartir de la date selectionner jusqu'a il y a une autre couleur

alors ma question est comment arreter le coloriage quand il y a une autre couleur ?
(mon idee etais de faire une boucle do while mais je ne sais pas quoi mettre comme valeur)

Pour le M je me suis trompé mais bon c'était juste pour expliquer le principe  

Bon je l'ai expliqué mais à la va-vite, apparament tu as fini les fonctions simples qui permettent de faire le programme principal. Voilà à quoi ca doit ressembler, je suis pas sur que tu ai mis les memes noms de variables mais si tu comprends la logique alors ca ira.

Private sub MajGraphique

    Dim i as long ' Position de la lecture des lignes du tableau des projet 

    Dim j as long ' Position de lecture des colonnes 

    Dim max as long ' Dernier enregistrement du nombre de projet

 
    Dim anc_pos as variant ' élément précedent du tableau 

    Dim pos as variant ' élément actuel du tableau 

 
    ' on détermine la fin du tableau 

    max = Range("B65536").end(xlup).row

    for i = K_PREM_LIGNE to max

        ' réinitialisation

        anc_pos = null 

        pos = null

        for j = K_COL_PRO to K_COL_PR4

            if cells(i,j) <> "" then ' pas de null en excel mais ""

               pos = GetPosition(cells(i,j))

               if not isnull(anc_pos) and not isnull(pos) then 

                   setcolor(i,anc_pos, pos -1) ' paramètre i ligne, anc_pos colonne de début , pos colonne de fin

               end if 

               anc_pos = pos 

               pos = null

            end if 

        next

    next 

End sub

Par contre il faut le cas ou tu as un project qui commence mais pas de date sur la phase suivante, est ce que tu veux colorier ou pas.
donc setcolor doit pour les paramètres que j'ai mis remplir les cases determiner par les coordonnées, il faut surement mettre aussi en paramètre la couleur.
Il serait bien de modifier GetPosition pour qu'elle renvoie null si elle trouve pas sinon rajouter un test après son appel

if pos = -1 then pos = null

C'est surement pas complet mais il y a la trame principale, n'oublie pas aussi de faire en sorte qu'il n'y est pas 2 fois la meme date dans 2 colonnes voisines sinon tu auras un problème

ok merci pour cette solution
mais j'en ai trouver une qui marche aussi
elle est moins jolie et j'ai fais surement des erreurs :

Public Const K_DEB_GRAPH = 13 'Column M

Public Const K_FIRST_LINE = 9

Public Const LINE_YEAR = 7

Public Const LINE_WEEK = 8

Public aa

Public i As Long

 
Function GetPosition(dtdate As String) As Long

Dim max As Long

Dim sem As Long

Dim an   As Long

Dim s As Long

 
GetPosition = -1

max = Range("IV" & LINE_YEAR).End(xlUp).Column 'return the number of the last column

If dtdate = "NA" Then

    GoTo Ends

Else

    If dtdate = "" Then

        aa = 789

        GoTo Ends

    Else

        If dtdate = "TBC" Then

            GoTo Ends

        Else

            If dtdate = "TBD" Then

                GoTo Ends

            End If

        End If

    End If

End If

' Jaar en Week uit datum halen

an = Left(dtdate, InStr(dtdate, ".") - 1) 'ex : 7

sem = Mid(dtdate, InStr(dtdate, ".") + 1) 'ex : 12

For i = K_DEB_GRAPH To max

    s = Cells(LINE_YEAR, i)

    If s = an Then

       If Cells(LINE_WEEK, i) = sem Then

            ' juiste kolom gevonden

            GetPosition = i

            aa = i

       End If

    End If

 Next i

Ends:

End Function

 
 
Sub test()

Dim q, w, c, l, v, n

i = 0

c = Application.ActiveCell.Column

l = Application.ActiveCell.Row

For x = l To l + 49 'Alle lijnen afgaan

    For p = 117 To 13 Step -1

        Range(NumCol2Letter(p) & x).Interior.ColorIndex = 2

    Next p

        For z = c + 4 To c Step -1 'Alle koloms afgaan

            aa = 0

            GetPosition (Range(NumCol2Letter(z) & x))

                If aa = 0 Then

                    GoTo Ends

                Else

                    If aa > 700 Then

                        GoTo Blanco

                    End If

                End If

                    If NumCol2Letter(z) = "E" Then

                        w = 40

                    Else

                        If NumCol2Letter(z) = "F" Then

                            w = 6

                        Else

                            If NumCol2Letter(z) = "G" Then

                                w = 4

                            Else

                                If NumCol2Letter(z) = "H" Then

                                    w = 43

                                Else

                                    If NumCol2Letter(z) = "I" Then

                                        w = 50

                                    End If

                                End If

                            End If

                        End If

                    End If

                For j = aa To 13 Step -1

                    Range(NumCol2Letter(j) & x).Interior.ColorIndex = w

                Next j

                    GoTo Ends

Blanco:

                For k = 117 To 13 Step -1

                    Range(NumCol2Letter(k) & x).Interior.ColorIndex = 2

                Next k

Ends:

        Next z

Next x

End Sub

 
 
Private Function Letter2NumCol(ByVal Chaine As String) As Long

Dim i As Long, ValeurCh As Long

Const ChaineAlpha As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    For i = 1 To Len(Chaine)

        ValeurCh = InStr(1, ChaineAlpha, Mid(UCase(Chaine), i, 1))

        Letter2NumCol = Letter2NumCol * 26 + ValeurCh

    Next

End Function

 
 
Private Function NumCol2Letter(ByVal NumCol As Long) As String

Dim i As Long, x As Long, n As String

    For i = 6 To 0 Step -1

        x = (26 ^ (i + 1) - 1) / 25 - 1

        If NumCol > x Then

            n = n & Chr(((NumCol - x - 1) \ 26 ^ i) Mod 26 + 65)

        End If

    Next i

     NumCol2Letter = n

End Function

y a tout le code et il marche comme il faut meme si il n'est tres joli  

C'est surtout l'utilisation de lettre en dur qui risque de poser problème, si un jour il rajoute une colonne plus rien ne fonctionne et tu devras tout reprendre ton code d'ou l'utilisation de constante pour limiter la casse en cas de changement

effectivement, ton programme marche bien aussi
mais je sais que le nombre de colonnes ne changera pas mais
je quand meme les remplacer par des constantes
merci pour ton aide

mais comment on peut voir quel est la couleur d'une cellule ?
par exemple :
dans une boucle for, on parcourt toutes les cellules et on releve leur couleur