Commande de macro par chiffre

Le 02/10/2008 à 10:53

Bonjour,

Peut-on faire démarrer une macro avec les chiffres d'une liste déroulante.

Exemple :

Sub Huit()

Range("Z2:Z16").Copy Destination:=Range("F10")

End Sub

Modèle joint

https://www.excel-pratique.com/~files/doc/Deroulante.xls

Merci de votre aide.

Le 02/10/2008 à 11:33

Bonjour,

sans les huits Sub, mais une seule :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then
nombre = Array("8", "10", "12", "14", "16", "18", "20", "22", "24")
Range("Z2:Z" & Val(nombre([A1] - 4))).Copy Destination:=Range("F10")
End If
End Sub

Si j'ai bien compris...

Le 02/10/2008 à 11:51

Bonjour,

C'est impeccable, merci.

Une petite question:

Quand je mets le code avec d'autre qui on la même ligne.

Private Sub Worksheet_Change(ByVal Target As Range)

ça pose un problème.

Est-il possible, d'avoir la liste déroulante en Feuil1 et le code en Feuil2 ?

Le 02/10/2008 à 12:06

Bonjour,

Il faut aussi effacer les données en F9:F34 avant de faire la copie.

Range("F9:F34").ClearContents

Alain

Le 02/10/2008 à 12:06

Re-,

non, il faut que tu composes avec les autres codes

Comme c'est un évènement de la feuille1, et que tu agis sur cette feuille, le code doit être dans l'évènement de cette feuille

Cependant, mets tous tes codes ici, on doit pouvoir les imbriquer

Le 02/10/2008 à 12:25

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("AZ12:BJ14")) Is Nothing Then Exit Sub

Select Case (Target.Value)

Case "1": Target.Interior.ColorIndex = 3

Target.Font.ColorIndex = 3

Case "2": Target.Interior.ColorIndex = 4

Target.Font.ColorIndex = 4

Case "3": Target.Interior.ColorIndex = 5

Target.Font.ColorIndex = 5

Case "4": Target.Interior.ColorIndex = 6

Target.Font.ColorIndex = 6

Case "5": Target.Interior.ColorIndex = 7

Target.Font.ColorIndex = 7

Case "6": Target.Interior.ColorIndex = 8

Target.Font.ColorIndex = 8

Case "7": Target.Interior.ColorIndex = 9

Target.Font.ColorIndex = 9

Case "8": Target.Interior.ColorIndex = 31

Target.Font.ColorIndex = 31

Case "9": Target.Interior.ColorIndex = 44

Target.Font.ColorIndex = 44

Case "10": Target.Interior.ColorIndex = 43

Target.Font.ColorIndex = 43

Case "11": Target.Interior.ColorIndex = 12

Target.Font.ColorIndex = 12

Case "12": Target.Interior.ColorIndex = 39

Target.Font.ColorIndex = 39

Case "": Target.Interior.ColorIndex = xlNone

End Select

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then

nombre = Array("8", "10", "12", "14", "16", "18", "20", "22", "24")

Range("AZ19:AZ" & Val(nombre([A1] - 4))).Copy Destination:=Range("F15")

End If

End Sub

12liste.xlsm (79.74 Ko)
Le 02/10/2008 à 12:57

Re-,

comme ceci, peut-être?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then
    nombre = Array("8", "10", "12", "14", "16", "18", "20", "22", "24")
    Range("AZ19:AZ" & Val(nombre([A1] - 4))).Copy Destination:=Range("F15")
End If
If Intersect(Target, Range("AZ12:BJ14")) Is Nothing Then Exit Sub
    Select Case (Target.Value)
        Case "1": Target.Interior.ColorIndex = 3
            Target.Font.ColorIndex = 3
        Case "2": Target.Interior.ColorIndex = 4
            Target.Font.ColorIndex = 4
        Case "3": Target.Interior.ColorIndex = 5
            Target.Font.ColorIndex = 5
        Case "4": Target.Interior.ColorIndex = 6
            Target.Font.ColorIndex = 6
        Case "5": Target.Interior.ColorIndex = 7
            Target.Font.ColorIndex = 7
        Case "6": Target.Interior.ColorIndex = 8
            Target.Font.ColorIndex = 8
        Case "7": Target.Interior.ColorIndex = 9
            Target.Font.ColorIndex = 9
        Case "8": Target.Interior.ColorIndex = 31
            Target.Font.ColorIndex = 31
        Case "9": Target.Interior.ColorIndex = 44
            Target.Font.ColorIndex = 44
        Case "10": Target.Interior.ColorIndex = 43
            Target.Font.ColorIndex = 43
        Case "11": Target.Interior.ColorIndex = 12
            Target.Font.ColorIndex = 12
        Case "12": Target.Interior.ColorIndex = 39
            Target.Font.ColorIndex = 39
        Case "": Target.Interior.ColorIndex = xlNone
    End Select
End Sub

PS : tu remarqueras que j'ai mis le code entre les bornes [Code ]

Tu cliques sur le bouton "Code", en haut, tu colles ton code, et tu recliques sur le bouton "/code", pour fermer la borne

Et également, que j'ai indenté ton code, c'est à dire que j'utilise la tabulation, afin que le code soit bien plus lisible. C'est une bonne habitude à prendre

Bonne journée

Le 02/10/2008 à 13:04

Re-bonjour,

Code à mettre dans Workbook.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then
    nombre = Array("8", "10", "12", "14", "16", "18", "20", "22", "24")
    Range("F9:F34").ClearContents
    Range("Z2:Z" & Val(nombre([A1] - 4))).Copy Destination:=Range("F10")
End If

If Intersect(Target, Range("AZ12:BJ14")) Is Nothing Then Exit Sub
Select Case (Target.Value)
Case "1": Target.Interior.ColorIndex = 3
Target.Font.ColorIndex = 3
Case "2": Target.Interior.ColorIndex = 4
Target.Font.ColorIndex = 4
Case "3": Target.Interior.ColorIndex = 5
Target.Font.ColorIndex = 5
Case "4": Target.Interior.ColorIndex = 6
Target.Font.ColorIndex = 6
Case "5": Target.Interior.ColorIndex = 7
Target.Font.ColorIndex = 7
Case "6": Target.Interior.ColorIndex = 8
Target.Font.ColorIndex = 8
Case "7": Target.Interior.ColorIndex = 9
Target.Font.ColorIndex = 9
Case "8": Target.Interior.ColorIndex = 31
Target.Font.ColorIndex = 31
Case "9": Target.Interior.ColorIndex = 44
Target.Font.ColorIndex = 44
Case "10": Target.Interior.ColorIndex = 43
Target.Font.ColorIndex = 43
Case "11": Target.Interior.ColorIndex = 12
Target.Font.ColorIndex = 12
Case "12": Target.Interior.ColorIndex = 39
Target.Font.ColorIndex = 39
Case "": Target.Interior.ColorIndex = xlNone
End Select

End Sub

Alain

Le 02/10/2008 à 15:24

Re

Je te remercie pour tout.

Mais, j'ai quand même un problème (de ma faute).

Finalement je doit changer le départ et la destination.

Le départ est AZ20 et l'arrivé est à F16.

J'ai bien changé quelque chose (avec bien du mal),

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then

nombre = Array("16", "18", "20", "22", "24", "26", "28", "30", "32")

Range("AZ19:AZ" & Val(nombre([A1] + 2))).Copy Destination:=Range("F15")

mais je suis quand même bloqué à 7

tu dois bien avoir une idée ?

Le 02/10/2008 à 15:49

J'ai beau changer juste les noms des cellules, mais rien ne vas, ça ne vas pas aux endroits définis.

même avec la solution de slade47

Je n'y comprends rein ?

Le 02/10/2008 à 18:04

Re-,

rejoins un fichier avec ce que tu veux exactement

Nota, le [A1] - 4 donne l'index de la zone nommée "nombre"

Comme le premier index est le 0, nombre(0) te donne la première valeur de nombre, soit 16, dans ton code, si tu sélectionnes 4 dans la cellule A1

Donc, si ta cellule [A1] va de 4 à 12, il faut garder ce [A1]-4, et non [A1] + 2

Le 02/10/2008 à 19:06

Bonjour,

Excuse-moi pour le mélange que j'ai fait dans mes explications, mais je pensais que c'était pas si difficile ( pour moi).

Voici un exemple avec les cellules prévues.

https://www.excel-pratique.com/~files/doc/j38nbExemple.xls

Encore merci de ton aide

Le 02/10/2008 à 19:22

Re

le code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then
    nombre = Array("26", "28", "30", "32", "34", "36", "38", "40", "42")
    With Range("F16:F38")
        .Interior.ColorIndex = xlNone
        .Borders.LineStyle = xlNone
        .ClearContents
    End With
    Range("AZ20:AZ" & Val(nombre([A1] - 4))).Copy Destination:=Range("F16")
End If
End Sub

le fichier :

https://www.excel-pratique.com/~files/doc/Copie_de_j38nbExemple.xls

Le 02/10/2008 à 19:42

Ça fonctionne, merci encore pour ta patience.

J'ai simplement supprimé

Interior.ColorIndex = xlNone

.Borders.LineStyle = xlNone

.ClearContents

Car ça va sur un fond coloré sans ça, j'ai une trainée blanche, j'espère que ça ne perturberas pas le fonctionnement ?

Et ...............MERCI ENCORE

Le 02/10/2008 à 19:51

Re,

Ben, si je les ai mis.....

si tu demandes 9

puis ensuite, tu demandes 4

Comme l'avait fort justement remarqué Slade47, supprimer les anciennes valeurs, avant d'en demander de nouvelles...

A toi de voir

PS : n'oublie pas de mettre "Résolu", dans ton fil, si tu as obtenu ce que tu veux

Le 02/10/2008 à 20:39

Ok d'accord et encore merci de ton aide, je vais réfléchir.

Donc problème résolu

et satisfait des communications. :wink:

Le 03/10/2008 à 00:26

Salut le forum

Spool (Alias GuySarthe), tu n'oublies pas une petite formalité ...

  • Dès que votre problème est résolu, merci de le marquer en tant que [Résolu]
    grâce à l'utilitaire se trouvant en bas de page, aperçu :
Mytå

P.S. Tu peux faire la même chose sur l'autre forum. Merci !

Le 03/10/2008 à 07:14

Bonjour Mtyta

Sur ce Forum, je ne savais pas comment faire pour mettre résolu.

Quand à faire des réflexion comme tu le fait, je ne vois pas l'intérêt :roll:

En tout cas, je remerçie félix de sa patience, et j'en aurais fait autant si je m'y connaissait .

Le 03/10/2008 à 23:58

Salut le forum

Spool, le fait de faire du mutli-postage sans le préciser, c'est que je t'ai donné

une début de solution sur un autre forum, avant de venir ici.

Si tu l'avais mentionner ici ou sur l'autre forum, cela m'aurait éviter de commencer

un travail qui ne sert plus à rien.

Au plaisir de se reparler, sur d'autres ficelles

Mytå

Rechercher des sujets similaires à "commande macro chiffre"