Code vba...un peu d''aide svp

memene · 12 Juillet 2011

Bonsoir à tous,

Je ne m'y connais pas en VBA et je voudrais créer plusieurs codes pour répondre à mes attentes.
Dans mon fichier, que je vous ai mis en PJ, je souhaiterais:

- en double cliquant sur une des cellules entre c18:g18, elle devient rouge. Si je double-clique sur une autre, elle devient rouge à son tour en remplacement de la précédente. Ensuite, en fonction de la cellule rouge, s'inscrit en n18, un nombre correspondant: si c18 rouge alors n18=0, si d18 rouge alors n18=0.5, si e18 rouge alors n18=1...si g18 rouge alors n18=2
- je souhaiterais reproduire le même code pour c20:g20, c22:g22, c24:g24,c26:g26 avec n20, n22, n24, n26
- je souhaiterais enfin le même genre de code pour c33:h33, c35:h35,c37:h37, c39:h39 sauf que n33 peut s'étendre de 0 à 2.5 (c=0, d=0.5...h=2.5)

Le plus simple pour bien comprendre est sans doute d'utiliser le fichier que je vous transmets.
Merci d'avance pour vos réponses

Memene

CHALET53 · 12 Juillet 2011

Re : Code vba...un peu d''aide svp

Bonjour,

Il y a sûrement plus simple.
Si c'est bon tu peux poursuivre dans le même sens

a+

Grand Chaman Excel · 12 Juillet 2011

Re : Code vba...un peu d''aide svp

Bonjour memene,

Voici une proposition. Tu dois mettre le code dans la feuille "5"

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim notes() As Variant

notes = Array(0, 0.5, 1, 1.5, 2, 2.5)
    If Target.Columns.Count > 1 Then Exit Sub
    
    'De 18 à 27
    If Target.Column >= 3 And Target.Column <= 7 Then
        If Target.Row >= 18 And Target.Row <= 27 Then
            Range(Cells(Target.Row, 3), Cells(Target.Row, 7)).Interior.ColorIndex = xlNone
            Target.Interior.ColorIndex = 3
            Range("N" & Target.Row) = notes(Target.Column - 3)
        End If
    End If
    
    'De 33 à 40
    If Target.Column >= 3 And Target.Column <= 8 Then
        If Target.Row >= 33 And Target.Row <= 40 Then
            Range(Cells(Target.Row, 3), Cells(Target.Row, 8)).Interior.ColorIndex = xlNone
            Target.Interior.ColorIndex = 3
            Range("N" & Target.Row) = notes(Target.Column - 3)
        End If
    End If

End Sub

A+

Edit: Bien vu Staples! Merci.

Staple1600 · 12 Juillet 2011

Re : Code vba...un peu d''aide svp

Bonsoir le fil, tout le monde

Pour info:
Erreur de syntaxe : C'est xlNone pas none

EDITION: Je me permets d'ajouter des endives (mon péché mignon 😉 )

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim notes() As Variant

notes = Array(0, 0.5, 1, 1.5, 2, 2.5)
    If Target.Columns.Count > 1 Then Exit Sub
   
    'De 18 à 27
    With Target
   If .Column >= 3 And .Column <= 7 Then
        If .Row >= 18 And .Row <= 27 Then
            Cells(.Row, 3).Resize(, 5).Interior.ColorIndex = xlNone
            .Interior.ColorIndex = 3
            Range("N" & .Row) = notes(.Column - 3)
        End If
    End If
   
    'De 33 à 40
   If .Column >= 3 And .Column <= 8 Then
        If .Row >= 33 And .Row <= 40 Then
            Cells(.Row, 3).Resize(, 6).Interior.ColorIndex = xlNone
            .Interior.ColorIndex = 3
            Range("N" & .Row) = notes(.Column - 3)
        End If
    End If
    End With
End Sub

EDITION: Bonsoir Robert

Bebere · 12 Juillet 2011

Re : Code vba...un peu d''aide svp

bonjour Memene,Staple,Chalet
ma pierre à l'édifice
à bientôt

memene · 13 Juillet 2011

Re : Code vba...un peu d''aide svp

Super! vous avez trouvé ce que je voulais.
Merci à tous.
J'ai posté un autre message où je n'ai pas de réponse...pouvez-vous y répondre svp?
Je vous mets le lien: https://www.excel-downloads.com/threads/comment-enregistrer-excel-en-pdf-besoin-daide-svp.166734/

Si vous avez le temps d'y jeter un œil merci.

Bonne nuit
Memene

Fo_rum · 13 Juillet 2011

Re : Code vba...un peu d''aide svp

Bonsoir,

@Staple : tes endives avec une sauce personnelle.

Code:

Dim Li As Long, Col As Byte
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Li = Target.Row: Col = Target.Column
    If Not Intersect(Target, Range("C18:G27")) Is Nothing Then suite 5
    If Not Intersect(Target, Range("C33:H40")) Is Nothing Then suite 6
    Cells(Li, 1).Select
End Sub
Private Sub suite(n)
    Cells(Li, 3).Resize(, n).Interior.ColorIndex = xlNone
    ActiveCell.Interior.ColorIndex = 3
    Range("N" & Li) = Array(0, 0.5, 1, 1.5, 2, 2.5)(Col - 3)
End Sub

Staple1600 · 13 Juillet 2011

Re : Code vba...un peu d''aide svp

Bonsoir Fo_rum

Je n'ai pas de chapeau.

Mais là, je sors ma casquette et je la mets basse 😉

Bebere · 13 Juillet 2011

Re : Code vba...un peu d''aide svp

bonjour à tous
Staple
amour de l'endive(chicon) partagé
une préparation,cuire dans du beurre,salé,poivré
ajouté un peu d'eau,couvrir
vers la fin saupoudré de sucre et laissé un peu caramélisé
à bientôt

Fo_rum · 13 Juillet 2011

Re : Code vba...un peu d''aide svp

Re,

et avec une préparation* des plus concentrées ?

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C18:G27,C33:H40")) Is Nothing Then Exit Sub
    Cells(Target.Row, 3).Resize(, 5 - (Target.Column = 8)).Interior.ColorIndex = xlNone
    Target.Interior.ColorIndex = 3
    Cells(Target.Row, 14) = Array(0, 0.5, 1, 1.5, 2, 2.5)(Target.Column - 3)
End Sub

* moins savoureuse et plus difficile à suivre que celle de Bebere 🙂 !

Code vba...un peu d''aide svp

memene

Guest

Pièces jointes

CHALET53

XLDnaute Barbatruc

Pièces jointes

Grand Chaman Excel

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Bebere

XLDnaute Barbatruc

Pièces jointes

memene

Guest

Fo_rum

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Bebere

XLDnaute Barbatruc

Fo_rum

XLDnaute Accro

Discussions similaires

Code vba...un peu d''aide svp

memene

Guest

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

memene

Guest

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency