Macro inputbox divers problèmes

[Hideki]

Bonjour tout le monde,


Je me permet de venir demander votre aide car je ne m’en sors plus avec mon super tableau Excel. Ce tableau est destiné à être utilisé par d’autres personnes que moi même, donc le but est de réduire les contraintes au maximum pour celles-ci.

L’idée était donc de créer des macros permettant d’améliorer l’utilisation pour les autres utilisateurs, mais aussi d’éviter certaines.
Comme vous pouvez le voir sur le fichier joint, j’ai crée des macros pour masquer ou afficher certaines plages de cellules.
En plus de cela j’ai créé deux macros, une pour ajouter un poste (ligne + colonne), et une pour supprimer un poste (ligne + colonne également).
Pour supprimer le poste RAS, par contre je souhaiterai améliorer l’ajout de poste si possible, avec plusieurs défis.

Grâce aux différents posts sur le forum j’ai pu malgré tout bien avancer mais certaines difficultés demeurent dans ce que j’aurais souhaité faire.

Pour le bouton « ajouter un poste » :
Après avoir entré les ajouts de ligne et colonne, la box permettrait alors de demander la famille de rattachement du poste et de là lui attribuer une couleur pour sa police.
Par exemple « A quelle famille appartient le poste ? Pour la famille 1 tappez 1, etc.»
Choix 1 : famille 1 (donc couleur X)
Choix 2 : famille 2 (couleur Y)
Choix 3 : famille 3 (couleur Z)

A la suite de cela et en fonction du choix opéré, il serait alors demandé le nom du poste, qui serait écrit dans la cellule correspondant dans la ligne ajoutée (ligne ** / colonne C) mais également dans la colonne ajoutée (ligne 1 / colonne **) (avec la couleur de police adaptée).

Comme je suis sympa, je pousse le vice un peu plus loin, sait-on jamais !

Si l’insertion ou suppression se fait à l’intérieur d’une plage de cellules, cela ne pose pas de problème, cela est bien pris en compte.
Par contre si cela se fait à une extrémité quelques problèmes se posent : le poste ajouté n’est alors rattaché à aucune plage de cellule, et n’est donc pas intégré dans les macros de masquage / affichage de filière.

L’idée serait donc de pouvoir également choisir par la box la filière de rattachement, et en fonction du choix, la plage de cellule serait alors étendue pour pouvoir l’intégrer.

Et en bonus s’il y en a qui ne se sont pas arrachés tous leurs cheveux, il faudrait que la cellule qui marque l’intersection entre la ligne et la colonne ajoutées soit grisée comme c’est le cas pour les autres.


Autre problème que je n’arrive pas à résoudre, en lien avec la demande précédente :
Lorsque un poste est ajouté, il copie les cellules coloriées présentes à la ligne au dessus, et à la colonne de gauche.
Malgré mes recherches je n’arrive pas à faire en sorte que le fond des cellules environnantes ne soit pas copié, si quelqu’un a l’astuce …


Désolé pour tout le blabla, j’espère que cela vous aura malgré tout aidé à cerner les difficultés, si cela n’est pas clair n’hésitez pas à me demander plus d’informations.

Pour l’instant j’essaye de bidouiller dans les macros mais je suis vraiment loin du résultat souhaité étant débutant en la matière.
Je ne sais pas si tout ce que je vous demande est faisable mais bon je tente ma chance des fois que ...


Merci d’avance à ceux qui prendront la peine de m’aider. En espérant que ça ne soit pas mission impossible ^^


PS : je tourne avec la version 2000 d'excel

 

[Hideki]

Re : Macro inputbox divers problèmes

Bonjour Skoobi, bonjour le forum,

Je répond avec un peu de retard :

Par rapport au fichier c'est bien cela, si l'insertion se fait en colonne K (et ligne 10 par conséquent) il faudrait pouvoir choisir à quelle filière l'associer.

Cela implique de pouvoir étendre la plage de cellule définie de la filière de rattachement, en sachant que sur le fichier original, les cellules A3 à A9, D2 à J2, sont fusionnées (et idem pour les autres filières), donc il faudrait pouvoir étendre cette fusion également.

Tout en sachant que sur le fichier original il y a en tout 7 filières, donc 14plages de cellules les concernant ... (et pour simplifier il y a donc 2 plages de cellules à étendre par filière)
Du coup l'extension doit pouvoir se faire si le métier est ajouté au début de la filière ou à la fin ...


Après test si on étend une plage de cellule d'une filière, cela se répercute pour les autres filières donc là dessus normalement il n'y a rien à gérer.



En espérant avoir été clair, et merci d'avance encore une fois ^^
Je vais me remettre dessus mais pour l'instant je sèche un peu sur la méthode à adopter ...

 

[Hideki]

Re : Macro inputbox divers problèmes

Rebonjour,

J'ai voulu commencer par opérer la fusion de cellules, toujours dans la même macro, après le Dim Couleur:

Dim Filiere As String
Filiere = InputBox("A quelle filière est rattaché le métier ?", "Filière de rattachement")
If Filiere = "" Then Exit Sub
If Filiere > 7 Then Exit Sub

Puis cela (après que la ligne et la colonne aient été ajoutées) :

If Filiere = 1 Then
Range("Filière_1_1").Select
Range("A" & wt).Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 90
.AddIndent = False
.ShrinkToFit = False
End With
Selection.Merge
End If

En faisant de même pour chaque filière, et également pour le "Filière_1_2" etc.

Mais cela ne marche pas (pas de message d'erreur).



Des idées de ce qui ne va pas dans le code



Edit :

En essayant avec ce code :

If Filiere = 1 Then Range(("Filière_1_1"), ("A" & "wt")).Merge

cela fusionne mais un peu trop ...

 

[skoobi]

Re : Macro inputbox divers problèmes

Bonjour Hideki,

Je te propose une autre manière de procéder.
Si la sélection est à cheval entre 2 filières, le code détecte cela et une boite de dialogue proposera de sélectionner une cellule de la filière souhaitée. La fusion est également gérée.
Il faudra bien faire attention aux noms données aux plage nommmées.
filière_1_1,
filière_1_2,
filière_2_1,
filière_2_2,
filière_1_3?

J'ai commanté le code. Si tu veux plus d'explication n'hésite pas .

Sub AjoutPoste()[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Dim Ajout_metier As String, Choix As Range, Nom As Name
Metier = InputBox("Quel est l'intitulé du nouveau métier ?", "Ajout métier")[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Dim Couleur As String
Couleur = InputBox("A quelle famille est rattachée le métier ? 1 : Coeur de métier ; 2 : Support au coeur de métier ; 3 : Support général", "Ajout de métier")[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Dim wt As String
wt = InputBox("A partir de quelle ligne souhaitez vous insérer un métier ? (La ligne sera insérée au dessus)", "Ajout de métier")
If wt = "" Then Exit Sub
If wt > 0 And wt < 5000 Then Rows(wt).Insert Shift:=xlDown
Rows(wt).Interior.ColorIndex = xlNone
Range("C" & wt).Select[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 1 Then
Selection.Font.ColorIndex = 5
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 2 Then
Selection.Font.ColorIndex = 13
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 3 Then
Selection.Font.ColorIndex = 4
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]ActiveCell.Value = Metier[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]
Dim rt As String
rt = InputBox("A partir de quelle colonne souhaitez vous insérer un métier ? (La colonne sera insérée à gauche)", "Ajout de métier")
If rt = "" Then Exit Sub
Columns(rt).Insert
Columns(rt).Interior.ColorIndex = xlNone
Range(rt & "1").Select[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 1 Then
Selection.Font.ColorIndex = 5
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 2 Then
Selection.Font.ColorIndex = 13
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Couleur = 3 Then
Selection.Font.ColorIndex = 4[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End If
ActiveCell.Value = Metier[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Range("Start").Activate
Range(rt & wt).Interior.ColorIndex = 15
'====================== FILIERE "VERTICALE" =========================
'ici on regarde si la colonne choisie se trouve à cheval entre deux filières "verticales".
'si c'est le cas on demande via une boite de dialogue dans quelle filière associer ce
'nouveau poste
For Each Nom In ThisWorkbook.Names
  If Range(Nom.Name)(1).Column - 1 = Range(rt & wt).Column Or Range(Nom.Name)(Range(Nom.Name).Count).Column + 1 = Range(rt & wt).Column Then
    Set Choix = Application.InputBox("Choisissez une filière en sélectionnant une cellule.", "Filière verticale", Type:=8)
    Exit For
  End If
Next
'ici on vérifie qu'un choix de filière a été demandé
If Not Choix Is Nothing Then
'là on redimensionne la filière "verticale" concernée
  For Each Nom In ThisWorkbook.Names
    If Not Intersect(Choix, Range(Nom.Name)) Is Nothing And Nom.Name Like "Filière*2" Then
      LigD = Range(Nom.Name)(1).Row: ColD = Range(Nom.Name)(1).Column
      LigF = Range(Nom.Name)(Range(Nom.Name).Count).Row: ColF = Range(Nom.Name)(Range(Nom.Name).Count).Column
      If Range(rt & wt).Column < Range(Nom.Name)(1).Column Then
        ColDNew = Range(rt & wt).Column: ColFNew = ColF
      Else
        ColDNew = ColD: ColFNew = ColF: ColFNew = Range(rt & wt).Column
      End If
'là on met à jour la fusion de cellules
      Range(Cells(2, ColDNew), Cells(2, ColFNew)).Merge
'là le redimensionnement
      Range(Cells(LigD, ColDNew), Cells(LigF, ColFNew)).Name = Nom.Name
      Exit For
    End If
  Next
End If
Set Choix = Nothing
'====================== FILIERE "HORIZONTALE" =========================
'ici on regarde si la ligne choisie se trouve à cheval entre deux filières "horizontale".
'si c'est le cas on demande via une boite de dialogue dans quelle filière associer ce
'nouveau poste
For Each Nom In ThisWorkbook.Names
  If Range(Nom.Name)(1).Row - 1 = Range(rt & wt).Row Or Range(Nom.Name)(Range(Nom.Name).Count).Row + 1 = Range(rt & wt).Row Then
    Set Choix = Application.InputBox("Choisissez une filière en sélectionnant une cellule.", "Filière horizontale", Type:=8)
    Exit For
  End If
Next
'ici on vérifie qu'un choix de filière a été demandé
If Not Choix Is Nothing Then
'là on redimensionne la filière "horizontale" concernée
  For Each Nom In ThisWorkbook.Names
    If Not Intersect(Choix, Range(Nom.Name)) Is Nothing And Nom.Name Like "Filière*1" Then
      LigD = Range(Nom.Name)(1).Row: ColD = Range(Nom.Name)(1).Column
      LigF = Range(Nom.Name)(Range(Nom.Name).Count).Row: ColF = Range(Nom.Name)(Range(Nom.Name).Count).Column
      If Range(rt & wt).Row < Range(Nom.Name)(1).Row Then
        LigDNew = Range(rt & wt).Row: LigFNew = LigF
      Else
        LigDNew = LigD: LigFNew = LigF: LigFNew = Range(rt & wt).Row
      End If
'là on met à jour la fusion de cellules
      Range(Cells(LigDNew, 1), Cells(LigFNew, 1)).Merge
'là le redimensionnement
      Range(Cells(LigDNew, ColD), Cells(LigFNew, ColF)).Name = Nom.Name
      Exit For
    End If
  Next
End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End Sub