Ecrire dans le code d'une feuille par macro

Signaler
Messages postés
17
Date d'inscription
mercredi 17 janvier 2007
Statut
Membre
Dernière intervention
16 juillet 2009
-
Messages postés
17
Date d'inscription
mercredi 17 janvier 2007
Statut
Membre
Dernière intervention
16 juillet 2009
-
Salut tout le monde,


Je reviens à la charge (pour une dernière question j'espère...).


J'ai quasiment bouclé ma macro mais il me reste un dernier truc à gérer.
En fait ma macro, suivant le choix de l'utilisateur, va créer X feuilles dont les données vont ensuite être exposées en tableaux et graphique. J'ai une macro qui doit se trouver dans le code de chaque feuille pour que quand je clique dans la colonne 20 ça change l'état de la colonne 21 en OUI ou NON.
Or vu que le fichier excel ne démarre qu'avec la feuil1 vierge et que tout le reste est crée ensuite par la macro il me faut une macro qui va venir écrire le code dans les feuilles 1à x....


J'ai essayé ça mais bizaremment ça ne marche pas, j'ai parcouru pas mal de forum sans succès...si quelqu'un pouvait m'aider là dessus ça me sauverait bien.


Exemple de ce que j'ai essayé :


Sub InsertionMacroFeuilles()
Dim X As Integer
Dim a As Integer
Dim N As String
Dim O As String
 
N = "NON"
O = "OUI"
 
For a = 1 To Compteur
 
With ActiveWorkbook.VBProject.VBComponents("Feuil" & a & "").CodeModule
    X = .CountOfLines
    .InsertLines X + 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
    .InsertLines X + 2, "If Target.Column <> 20 Then Exit Sub"
    .InsertLines X + 3, "Select Case Target.Offset(0, 1)"
    .InsertLines X + 4, "Case True"
    .InsertLines X + 5, "Target.Offset(0, 1) = N"
    .InsertLines X + 6, "Case False"
    .InsertLines X + 7, "Target.Offset(0, 1) = O"
    .InsertLines X + 8, "Case Else"
    .InsertLines X + 9, "Target.Offset(0, 1) = N"
    .InsertLines X + 10, "End Select"
    .InsertLines X + 11, "Target.Offset(0, 1).Select"
    .InsertLines X + 12, "End Sub"
End With
End Sub

5 réponses

Messages postés
114
Date d'inscription
lundi 5 février 2007
Statut
Membre
Dernière intervention
10 septembre 2010

Salut,

écoutes j'ai pas tout compris. Pourquoi ne passes-tu pas par une macro auto_open() qui se chargera en premier à l'ouverture du classeur et qui fera la vérif/mise à jour automatiquement.

De plus, je vois pas pourquoi tu dois "réécrire" chaque fois un code alors qu'il ne s'agit que d'un simple contrôle de valeurs, qui plus est limité à une seul colonne.

Perso, je mettrai plutôt une formule dans chaque cellule de la colonne 21 du type :
SI(T10;"Non";"Oui")

C'est plus léger et plus réactif.

En espérant ne pas avoir répondu à côté de la plaque. Ce matin, j'ai de la buée sur les lunettes.

@+
Messages postés
17
Date d'inscription
mercredi 17 janvier 2007
Statut
Membre
Dernière intervention
16 juillet 2009

Salut Xpert,

En fait à l'origine j'avais dans la colonne 20 des checkbox, or c'était TRES TRES long d'insérer les checkbox a chaque ligne (plus de 2000) et sur chaque feuille. Or vu que l'exigence est qu'il faut que le passage de Vrai (oui) à Faux (non) se fasse par click et non par saisi de Oui ou Non par l'utilisateur il me faut une macro de ce style...

Je n'ai pas bien saisi ce que tu veux dire par vérif/mise à jour....
En fait à l'ouverture de mon fichier il n'y a rien dans mon classeur (juste Feuil1 vide). Ensuite l'utilisateur indique combien d'opération il veut analyser, ce qui a pour impact de créer autant de feuilles, d'y importer des données et ensuite une analyse en tableau et graphique reprend les données des différentes feuilles.
De plus l'utilisateur doit pouvoir exclure des taches de cette analyse, et c'est à ça que sert la colonne 21 oui ou non....

Je dois donc trouver un moyen de faire écrire ma macro " Private Sub Worksheet_SelectionChange(ByVal Target As Range)"  dans le code de chaque feuille de 1 à x
et c'est ca que je n'arrive pas à faire
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
Salut,

il est possible de faire la meme chose en ecrivant le code qu'une seule fois! Au lieu de l'ecrire dans le code de la feuille il suffit de l'ecrire dans le code du fichier. Cette page de code s'appelle "ThisWorkBook".

En suite plutot que de creer ton fichier à partir d'un fichier vide tu peux le faire à partir d'un fichier model qui contient déjà le code.

De plus tu trouveras un snippet ici : http://www.codyx.org/snippet_pseudo-checkbox_712.aspx

qui permet d'avoir des pseudo checkbox dans une colonne.
La methode ici ne fait pas appel au control checkbox. L'astuce est que toutes les cellules de la colonne spécifiée deviennent des checkbox.

Pour pouvoir utiliser ce snippet tout en appliquant ma remarque concernant la page de code "ThisWorkBook" il faut mettre la partie de code suivante dans un module:

Option Explicit

Const Marque As String = "\/"
Public Maplage As Range
Sub PseudoCheckBox(ByRef Target As Range, Optional ByVal Colonne As String = "A")
Dim MaCellule As Range, TempPlage As Range

'on verifi que la variable target pointe sur la colonne specifiée et sur une cellule unique
On Local Error Resume Next
If Target.Column Columns(Colonne).Column And Target.Cells.Count 1 Then
If Not Err = 0 Then Exit Sub
'on desactive la mise a jour de l'affichage
Application.ScreenUpdating = False
Application.EnableEvents = False
'si la variable target pointe sur une cellule qui contient deja la marque
If Target.Value = Marque Then
'on efface le contenu de la cellule
Target.ClearContents
'on vide la variable MaPlage
Set Maplage = Nothing
'on recuppere toute les cellules qui contiennent du text sur la colonne spécifiée
Set TempPlage = Columns(Colonne).SpecialCells(xlCellTypeConstants, 2)
'on vas verifier si ce text est une marque
For Each MaCellule In TempPlage
If MaCellule.Value = Marque Then 'si c'est une marque
'on reconstruit alors MaPlage
If Maplage Is Nothing Then 'premier passage
'entirerow sert a selectionner toute la ligne de la cellule pointee par MaCellule
Set Maplage = MaCellule.EntireRow
Else 'les autres passages
Set Maplage = Union(Maplage, MaCellule.EntireRow)
End If
End If
Next
On Error Resume Next
Maplage.Select

'si la variable target pointe sur une cellule vide
ElseIf Target.Value = "" Then
With Target
.Value = Marque 'on lui ajoute une marque
'on met en forme la cellule
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

'on met en forme la marque
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.Size = 7
End With
With Target.Characters(Start:=2, Length:=1).Font
.Name = "Arial"
.FontStyle = "Italic"
.Size = 12
End With

On Error Resume Next
Maplage.Select
Set Maplage = Union(Selection, Rows(Target.Row))
Maplage.Select
End If
'on reactive la mise a jour de l'affichage
Application.ScreenUpdating = True
Application.EnableEvents = True
'si on clic en dehors de la colonne specifiée elle sera vidée de ses marques (Option)
ElseIf Not Target.Column Columns(Colonne).Column And Target.Cells.Count 1 Then
'Columns(Colonne).ClearContents
'Set Maplage = Nothing
'Target.Select
End If
End Sub

puis mettre cette derniere partie dans ThisWorkBook :

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'exemple d'utilisation: les cellules de la colonne "B" se transforment en Checkbox
' pour permettre la selection ou deselection de ligne entiere, par simple clic(dans la colonne B)
Call PseudoCheckBox(Target, "B")
End Sub

A+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
11
oulaaaaaaa ! y a du NIX la-dessous !

bon je vous le poste avec les balises qui vont bien



Salut,

il est possible de faire la meme chose en ecrivant le code qu'une seule fois! Au lieu de l'ecrire dans le code de la feuille il suffit de l'ecrire dans le code du fichier. Cette page de code s'appelle "ThisWorkBook".

En suite plutot que de creer ton fichier à partir d'un fichier vide tu peux le faire à partir d'un fichier model qui contient déjà le code.

De plus tu trouveras un snippet ici : http://www.codyx.org/snippet_pseudo-checkbox_712.aspx

qui permet d'avoir des pseudo checkbox dans une colonne.
La methode ici ne fait pas appel au control checkbox. L'astuce est que toutes les cellules de la colonne spécifiée deviennent des checkbox.

Pour pouvoir utiliser ce snippet tout en appliquant ma remarque concernant la page de code "ThisWorkBook" il faut mettre la partie de code suivante dans un module:

Option Explicit

Const Marque As String = "\/"
Public Maplage As Range
Sub PseudoCheckBox(ByRef Target As Range, Optional ByVal Colonne As String = "A")
Dim MaCellule As Range, TempPlage As Range

'on verifi que la variable target pointe sur la colonne specifiée et sur une cellule unique
On Local Error Resume Next
If Target.Column Columns(Colonne).Column And Target.Cells.Count 1 Then
If Not Err = 0 Then Exit Sub
'on desactive la mise a jour de l'affichage
Application.ScreenUpdating = False
Application.EnableEvents = False
'si la variable target pointe sur une cellule qui contient deja la marque
If Target.Value = Marque Then
'on efface le contenu de la cellule
Target.ClearContents
'on vide la variable MaPlage
Set Maplage = Nothing
'on recuppere toute les cellules qui contiennent du text sur la colonne spécifiée
Set TempPlage = Columns(Colonne).SpecialCells(xlCellTypeConstants, 2)
'on vas verifier si ce text est une marque
For Each MaCellule In TempPlage
If MaCellule.Value = Marque Then 'si c'est une marque
'on reconstruit alors MaPlage
If Maplage Is Nothing Then 'premier passage
'entirerow sert a selectionner toute la ligne de la cellule pointee par MaCellule
Set Maplage = MaCellule.EntireRow
Else 'les autres passages
Set Maplage = Union(Maplage, MaCellule.EntireRow)
End If
End If
Next
On Error Resume Next
Maplage.Select

'si la variable target pointe sur une cellule vide
ElseIf Target.Value = "" Then
With Target
.Value = Marque 'on lui ajoute une marque
'on met en forme la cellule
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

'on met en forme la marque
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.Size = 7
End With
With Target.Characters(Start:=2, Length:=1).Font
.Name = "Arial"
.FontStyle = "Italic"
.Size = 12
End With

On Error Resume Next
Maplage.Select
Set Maplage = Union(Selection, Rows(Target.Row))
Maplage.Select
End If
'on reactive la mise a jour de l'affichage
Application.ScreenUpdating = True
Application.EnableEvents = True
'si on clic en dehors de la colonne specifiée elle sera vidée de ses marques (Option)
ElseIf Not Target.Column Columns(Colonne).Column And Target.Cells.Count 1 Then
'Columns(Colonne).ClearContents
'Set Maplage = Nothing
'Target.Select
End If
End Sub


puis mettre cette derniere partie dans ThisWorkBook :

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'exemple d'utilisation: les cellules de la colonne "B" se transforment en Checkbox
' pour permettre la selection ou deselection de ligne entiere, par simple clic(dans la colonne B)
Call PseudoCheckBox(Target, "B")
End Sub

A+
Messages postés
17
Date d'inscription
mercredi 17 janvier 2007
Statut
Membre
Dernière intervention
16 juillet 2009

Ca y'est j'ai trouvé ma solution, je vais en faire profiter les éventuels interessés en ésperant que cela puisse aider...

En fait ma macro pour inscrire le code est donc devenu ceci :

Sub EcrireCode()

' Ce code permet de recopier la macro Private Sub Worksheet_SelectionChange dans les feuilles bateaux
' c'est elle qui permet de faire fonctionner le principe de click dans la colonne 20 qui donne l'attribut
' VRAI ou FAUX dans la colonne 21

Dim i, LeCode(1 To 15)
Dim NomClasseur As String, NomFeuil As String
Dim Wb As Workbook
    NomClasseur = ActiveWorkbook.Name
    LeCode(1) = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
    LeCode(2) "   NbreLignes3+ Application.CountA(Range(""E1:E65536""))"
    LeCode(3) "Non ""NON"
    LeCode(4) "Oui ""OUI"
    LeCode(5) = "   If Intersect(Target, Range(""T5:T"" & NbreLignes)) Is Nothing Then Exit Sub"
    LeCode(6) = "   Select Case Target.Offset(0, 1)"
    LeCode(7) "       Case Is Oui"
    LeCode(8) "           Target.Offset(0, 1) ""NON"
    LeCode(9) "       Case Is Non"
    LeCode(10) "           Target.Offset(0, 1) ""OUI"
    LeCode(11) = "       Case Else"
    LeCode(12) "          Target.Offset(0, 1) ""OUI"
    LeCode(13) = "  End Select"
    LeCode(14) = "Target.Offset(0, 1).Select"
    LeCode(15) = "End sub"
    Set Wb = Workbooks(NomClasseur)
    
       For X = 2 To Compteur + 1
 
        For i = 1 To 15
            Wb.VBProject.VBComponents("Feuil" & X).CodeModule.InsertLines i, LeCode(i)
        Next i

      Next X
End Sub





Mais ce qui m'empéchait de la faire marcher était en fait une option de sécurité :

Dans Excel -> Outils -> Macro -> Sécurité... Onglet Editeurs approuvés, il faut cocher Faire confiance au projet Virtual Basic

Voila les amis merci pour l'aide précedente, en éspèrant que ça aide...