Faire un gantt via VBA

Version imprimable

05/10/2018, 13h22
augur6

2 pièce(s) jointe(s)

Faire un gantt via VBA

Bonjour,

Je tenais déjà par vous remercier car j'ai sous-mariné plus que de raison sur votre forum et grâce à ça j'ai pu briller en societé :mouarf:.
Je suis bidouilleur pour un petit site de RD et je suis en train de mettre en place un planning commun à toutes les équipes. Jusque là le cahier des charges m'allait bien et je m'en etais sorti via les formules excel :

l'utilisateur copie une source unique en ligne 1 issue de la base de donnée (copier automatiquement à l'ouverture sur l'onglet source) ça la copie sur la ligne 2, qui grace a la comparaison entre le NB.SI et le nombre de jour(colonne N de l'onglet sourcing) me faisait un gantt, couplé avec une recherchev en dessous me ramenait les actions à faire par jour.

et la c'est le drame, j'ai environ une cinquantaine de lignes planifiables ce qui suffisait jusqu'à l'arrivé d'un service qui à besoin de 200 possibilités soit 4 onglets et forcement le fichier fait 4Mo et ça sur 4 batiments :aie::aie::aie: avec un reseau d'entreprise erratique et des PC poussifs plus rien ne marche

j'ai commencé (depuis plus de 20h) à essayé de trouver une solution en VBA et ... je seche, j'ai bien peur que mes competences soient largement dépassées

si vous aviez des bouts de codes / pistes je suis preneur

encore merci pour ce que vous faites.

PS : en PJ la trame du fichier vour visualiser l'enginPièce jointe 417558

edit : je vais essayer d'etre plus clair
- A l'ouverture du fichier je copie une base de donnée ( çà c'est fait) sur l'onglet sourcing
- L'utilisateur doit coller une information unique de la BDD en ligne 4 (puis ligne 7 si 4 occupée, 10 si 7....)
- La macro doit prendre cette information rechercher la durée de l'étape(information en colonne A et durée colonne N onglet sourcing) et la coller X fois (durée) de façon linéaire pour faire un gantt via format conditionnel... et bien sur quand l'utilisateur la supprime ça doit l'effacer :piou:

visuellement ça donnait ça sous excel:
Pièce jointe 417586

et en fait, au niveau avancement je tourne en rond et j'arrive a rien.
05/10/2018, 14h24
lucasgaetan

Citation:

Envoyé par augur6

j'ai commencé (depuis plus de 20h)

Cela se lit, tes explications ne sont pas très claire, Si tu veux de l'aide reformule ta demande.
Surtout que pour nous aussi c'est la fin de semaine...

pour exemple
Ce que mon fichier et utilisateur sont sensés faire:
-à l'ouverture, la procédure Workbook_Open sélectionne la date du jour (feuille "100", ligne 3)
-l'utilisateur copie une source préalablement copiée dans un autre classeur ???? à l'aide d'un bouton ?
etc...

Puis expliquer où le problème se situe:
-y-a-t-il un message d'erreur de la part de VBA, le quel ?
-Qu'est-ce qu'il ne se passe pas comme prévue ?

Un effort de rédaction peu souvent te faire trouver la solution tout seul.
05/10/2018, 15h29
augur6

Citation:

Envoyé par lucasgaetan

Cela se lit, tes explications ne sont pas très claire, Si tu veux de l'aide reformule ta demande.
....

Un effort de rédaction peu souvent te faire trouver la solution tout seul.

Tu as raison, je panique peut etre un peu sur le coup. j'ai éditer et je vais me repencher sur le probleme ce week end :aie:
05/10/2018, 16h10
Invité

2 pièce(s) jointe(s)

bonjour,

je ne sais pas si tu cherche un truc comme ça?

Pièce jointe 417597
05/10/2018, 18h06
augur6

Citation:

Envoyé par dysorthographie

bonjour,

je ne sais pas si tu cherche un truc comme ça?

Alors à première vue c'est pas loin, à seconde vue pardonner moi l'expression : Putain !!!
.... et puis j'ai fait ALT+F11 et j'ai pleuré :piou::piou::piou:

j'avance mais doucement:

j'arrive à pointé sur mon nombre de jours associés à ma donnée d'entrée via cette macro (feuil1: saisie et feuil2: BDD) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, [A1:D1,A4:D4]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target = "" Then Target.Offset(0, 1) = "": GoTo fin
    numLigne = Application.Match(Target, Sheets("Feuil2").[A1:A8], 0)
    If IsError(numLigne) Then
        Target.Offset(1, 0) = "Pas trouvé"
    Else
        Target.Offset(1, 0) = Sheets("Feuil2").Cells(numLigne, 1) 'c'est ma valeur saisie et retrouvée
        Target.Offset(1, 1) = Sheets("Feuil2").Cells(numLigne, 2) 'c'est le nombre de jours et donc le nombre de fois que j'aimerai coller la donnée en ligne
    End If
fin:
    Application.EnableEvents = True
End Sub

c'est possible de copier ma_donnée et ça Sheets("Feuil2").Cells(numLigne, 2) fois sur la meme ligne ou c'est une heresie ?

1 pièce(s) jointe(s)

Pour la posterité et en cas de besoin les autres :) j'avance :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, [A1:NH1,A4:NH4]) Is Nothing Then Exit Sub ' plages ou la macro est active
    Application.EnableEvents = False ' evite la MAJ du visuel
    If Target = "" Then Target.Offset(0, 1) = "": GoTo fin
    numLigne = Application.Match(Target, Sheets("Feuil2").[A1:A8], 0) ' plage ou se trouve les données sources
    If IsError(numLigne) Then
        Target.Offset(1, 0) = "Pas trouvé" ' si il trouve pas
    Else
    ' range= selectionne une plage de donnée variable sous celle tapée (d) de la taille prévu dans la colonne b de la feuille 2(x) et copie la valeur d x fois
        Range(Target.Offset(1, 0), Target.Offset(1, Sheets("Feuil2").Cells(numLigne, 2).Value - 1)) = Sheets("Feuil2").Cells(numLigne, 1).Value
 
    End If
fin:
    Application.EnableEvents = True
End Sub

il me reste plus qu'à essayer d'inserer une boucle if :( et la copie des activité spécifique sous la ligne que je viens de créer et ça sera parfait.

encore merci à ceux qui repondent ici et ailleurs car j'ai encore adapté une réponse de ce forum :D

PS : si il y a des ameliorations à faire hesitez pas

Pièce jointe 418328

ajout de la ligne de code qui suit
Code:

1 2 3 4 Dim Ws As Worksheet Set Ws = Worksheets("Feuil2") Range(Target.Offset(2, 0), Target.Offset(2, Ws.Cells(numligne, 2).Value - 1)) = Ws.Range(Ws.Cells(numligne, 3), _ Ws.Cells(numligne, Ws.Cells(numligne, 2) + 2)).Value
permet de ramener une plage de donnée de la taille de la durée.

je suis pas mal :D

09/10/2018, 11h24
augur6

Help :calim2:

mon

Code:

If Intersect(Target, [A1:NH1,A4:NH4])

doit dans la vrai vie s'appliquer sur :

d4:nh4,d7:nh7,d10:nh10,d13:nh13,d16:nh16,d19:nh19,d22:nh22,d25:nh25,d28:nh28,d31:nh31,d34:nh34,d37:nh37,d40:nh40,d43:nh43,d46:nh46,d49:nh49,d52:nh52,
d55:nh55,d58:nh58,d61:nh61,d64:nh64,d67:nh67,d70:nh70,d73:nh73,d76:nh76,d79:nh79,d82:nh82,d85:nh85,d88:nh88,d91:nh91,d94:nh94,d97:nh97,d100:nh100,
d103:nh103,d106:nh106,d109:nh109,d112:nh112,d115:nh115,d118:nh118,d121:nh121,d124:nh124,d127:nh127,d130:nh130,d133:nh133,d136:nh136,d139:nh139,
d142:nh142,d145:nh145,d148:nh148,d151:nh151,d154:nh154,d157:nh157,d160:nh160,d163:nh163,d166:nh166,d169:nh169,d172:nh172,d175:nh175,d178:nh178,
d181:nh181,d184:nh184,d187:nh187,d190:nh190,d193:nh193,d196:nh196,d199:nh199,d202:nh202,d205:nh205,d208:nh208,d211:nh211,d214:nh214,d217:nh217,
d220:nh220,d223:nh223,d226:nh226,d229:nh229,d232:nh232,d235:nh235,d238:nh238

et là c'est le drame, comment je peux découper ça ?
09/10/2018, 14h20
lucasgaetan
RE,

Tu peux essayer avec une plage nommée.
Plage nommée: Formule / groupe "Noms définis" / Gestionnaire de noms
tu en crées une nouvelle comprenant les cellules d4:nh4,d7:nh7, etc... , dans l'exemple ci-dessous on l'appelle MonNomDePlage
Code:

1 2 3 If Not Intersect(Target, ActiveSheet.Range("MonNomDePlage")) Is Nothing Then 'ton code end if
attention "ActiveSheet" n'est peut être pas ce que tu veux.

merci beaucoup je m'en suis servi ailleurs :mrgreen:

pour mon cas j'ai utilisé :

Code:

1
2
3
4
5
6
If Intersect(Target, Union(Range( _
    "d4:nh4,d7:nh7,d10:nh10,d13:nh13,d16:nh16,d19:nh19,d22:nh22,d25:nh25,d28:nh28,d31:nh31,d34:nh34,d37:nh37,d40:nh40,d43:nh43,d46:nh46" _
    ), Range("d49:nh49,d52:nh52,d55:nh55,d58:nh58,d61:nh61,d64:nh64,d67:nh67,d70:nh70,d73:nh73,d76:nh76,d79:nh79,d82:nh82,d85:nh85,d88:nh88,d91:nh91" _
    ), Range("d94:nh94,d97:nh97,d100:nh100,d103:nh103,d106:nh106,d109:nh109,d112:nh112,d115:nh115,d118:nh118,d121:nh121,d124:nh124,d127:nh127" _
    ), Range("d130:nh130,d133:nh133,d136:nh136,d139:nh139,d142:nh142,d145:nh145,d148:nh148,d151:nh151,d154:nh154,d157:nh157,d160:nh160,d163:nh163" _
    ), Range("d166:nh166,d169:nh169,d172:nh172,d175:nh175,d178:nh178,d181:nh181,d184:nh184,d187:nh187,d190:nh190,d193:nh193,d196:nh196"))) Is Nothing Then Exit Sub ' plages ou la macro est active

je sais pas si c'est VBA friendly, mais ça marche

résolu et merci à ceux qui on pris le temps de lire mon bordel