Discussion :

[counterbob]

Bonjour
j'ai créé des codes qui, grace à des contrôles, permettent d'entrer des valeurs, la couleur de fond, couleur texte, insérer commentaire.
j'ai une vingtaine de choix dans mon fichier.
je souhaiterais réduire le nombre de lignes de codes grace au référence des cellule d'un tableau regroupant les informations.


Merci
Cordialement

voici le code actuel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Sub Radio_Conducteur_Click()
'statutPersonnel.Hide
 
'déverrouillage de la feuille
    ActiveSheet.Unprotect ("MDP")
    X = selection.Address
    'Ouverture de la boite de dialogue
    Set Y = Application.InputBox(prompt:="Selectionner les cellules de destination", Type:=8)
    Range(X).Copy
    Y.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 With selection.Interior
        'fond de cellule en violet
        .Color = RGB(255, 128, 0)
        .Pattern = xlSolid
        'texte de cellule = PLD
        selection.FormulaR1C1 = "MISSION"
        selection.Characters.Font.Size = 4
        'couleur texte identique au fond
        selection.Font.Color = RGB(255, 128, 0)
        'Index = Selection.Interior.ColorIndex
End With
    'insere commentaire
    With ActiveCell
        .ClearComments
        .AddComment
        .Comment.Visible = False 'ou True
        .Comment.Text Text:="Mission Conducteur"
        '.UserPicture = chemin
    End With
    'enlever Selection zone
   Range("A" & ActiveCell.Row).Select
    'Range("B2").Select
    'Protection feuille
    ActiveSheet.Protect Password:=("MDP"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
 End Sub
 
 Private Sub Radio_Convoyeur_click()
 
'déverrouillage de la feuille
    ActiveSheet.Unprotect ("MDP")
    X = selection.Address
    'Ouverture de la boite de dialogue
    Set Y = Application.InputBox(prompt:="Selectionner les cellules de destination", Type:=8)
    Range(X).Copy
    Y.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 With selection.Interior
        'fond de cellule en violet
        .Color = RGB(128, 64, 0)
        .Pattern = xlSolid
        'texte de cellule = PLD
        selection.FormulaR1C1 = "MISSION"
        selection.Characters.Font.Size = 4
        'couleur texte identique au fond
        selection.Font.Color = RGB(128, 64, 0)
        'Index = Selection.Interior.ColorIndex
End With
    'insere commentaire
    With ActiveCell
        .ClearComments
        .AddComment
        .Comment.Visible = False 'ou True
        .Comment.Text Text:="Mission Convoyeur"
        '.UserPicture = chemin
 
 End With
    'enlever Selection zone mémorisée
   Range("A" & ActiveCell.Row).Select
    'Range("B2").Select
    'protection de la feuille
    ActiveSheet.Protect Password:=("MDP"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

[Daniel.C]

Bonjour,

Franchement, je n'y comprends pas grand-chose. Pourquoi deux macros ? Peux-tu donner un exemple ?

[counterbob]

bonjour

les macros sont les anciens codes, je voudrais modifer mais il n'y a que la valeur qui est renvoyée, pas le format ni le commentaire.

La cellule B13 contient une valeur texte, avec un commentaire, une trame de fond et le texte en couleur.
mais la macro ne renvoit que la valeur dans la plage sélectionnée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Radio_Convoyeur()
 
 
 
    X = Selection.Address 'zone sélectionnée
    Z = Sheets("Feuil1").Range("b13") 'valeurs a copier avec le format et le commentaire
 
    'Ouverture de la boite de dialogue
    Set Y = Application.InputBox(prompt:="Selectionner les cellules de destination", Type:=8)
    Range(X).Copy
    Y.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
    Selection = Z 'copie le contenu dans la zone sélectionnée
    'le probleme c'est qu'il n'y a que la valeur qui est copiée
 
End Sub

[OBO29]

Bonjour,

Voici une piste pour toi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub Radio_Convoyeur()
 
    X = Selection.Address 'zone sélectionnée
    Z = Sheets("Feuil1").Range("b13") 'valeurs a copier avec le format et le commentaire
 
    'Ouvertue de la boite de dialogue
    Set Y = Application.InputBox(prompt:="Selectionner les cellules de destination", Type:=8)
    Range(X).Copy
    Y.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    Selection = Z 'copie le contenu dans la zone sélectionnée
    'le probleme c'est qu'il n'y a que la valeur qui est copiée
End Sub

[counterbob]

Merci
Mais il n'y a que la valeur qui est copiée, il manque le format et le commentaire de la cellule source.
j'ai fait ceci est ça fonctionne

merci pour l'idée

il me reste à créer une liste de choix de la colonne A et de renvoyer les données de la cellule de droite.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Radio_test()
 
    X = Selection.Address 'zone sélectionnée
 
 
    'Ouvertue de la boite de dialogue
    Set Y = Application.InputBox(prompt:="Selectionner les cellules de destination", Type:=8)
    Range(X).Copy
    Y.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    Sheets("Feuil1").Range("b15").Copy Selection
 
End Sub