Aide pour modifier un code visual basic

melba

XLDnaute Occasionnel
Bonjour,

Pourrais-je obtenir votre aide pour modifier un code que vous m'avez déjà fourni et que j'essaye vainement d'adapter à mes besoins?

Je suis débutante en la matière et ai beaucoup de mal.

Je joins un fichier qui je l'espère sera clair.


Merci par avance
 

Fichiers joints

Dernière édition:

Bebere

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

bonjour melba
à tester
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Couleur As Integer
    
                Application.EnableEvents = False

    If Target.Address = "$C$8" And Target.Count = 1 Then
        Couleur = Target.Interior.ColorIndex
        Select Case Target.Value
        Case ""
            Range("A10:G10").Clear
        Case Else
            If Year(Target.Value) < 2012 Then
                Range("A10") = "jetons"
                Range("C10:G10").Clear
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10:G10").Interior.ColorIndex = -4142
            End If

            If Year(Target.Value) >= 2012 Then
                Range("A10") = "jetons"
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10") = "mettre x si invité"
                Range("E10").Borders.Weight = xlThin
                Range("E10") = "il y aura un x si nécessaire"
            End If


        End Select

    End If
    
    If Target.Address = "$E$10" And Target.Count = 1 Then
        If Year(Range("C8").Value) >= 2012 And Target.Value = "x" Then
            Couleur = Range("C8").Interior.ColorIndex
            Range("A10") = "jetons"
            Range("C10").Interior.ColorIndex = Couleur
            Range("D10") = "mettre x si invité"
            Range("E10").Borders.Weight = xlThin
            '                    Range("E10") = "il y aura un x si nécessaire"
            Range("F10") = "cocktails"
            Range("G10").Interior.ColorIndex = Couleur
        End If
    End If
         Application.EnableEvents = True

End Sub
 

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonjour,

Merci pour la proposition, je l'examinerai ce soir

+
 

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonsoir,

J'ai enfin trouvé un moment pour expérimenter le code proposé par Bebere:

Il semble fonctionner mais je l'ai modifié pour la cellule E10 : en fait je ne souhaitais pas que la phrase "il y aura un x si nécessaire" apparaisse, c'était seulement pour dire à quoi était destinée cette cellule.
J'ai donc supprimé
Range("E10") = "il y aura un x si nécessaire"

du code.

Un petit problème avec la mise en forme : je souhaiterais que tout ce qui s'écrit dans :

- A10, C10:G10 aient un format "centré dans la cellule".

Par ailleurs j'ai besoin d'un format "renvoi à la ligne" en :

- A10,D10,F10

car dans ces cellules j'aurai en réalité des textes plus longs à inscrire .


J'ai crée une macro avec visual basic pour voir comment s'écrirait le code de ce formatage mais ne sais pas comment l'insérer dans le code proposé par Bebere

Range("A10:G10").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A10").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D10").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F10").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub


Merci pour votre réponse
 

DomiB

XLDnaute Nouveau
Re : Aide pour modifier un code visual basic

Bonjour Melba,

Vite fait je vous donne une indication en ce qui concerne les retours à la ligne.
Vous n'êtes pas obligée d'utiliser VBA pour çà, même si c'est aussi faisable.
Mais pour plus de souplesse, il vaut mieux les insérer directement dans les textes concernés, en les transformant en "formules", c'est-à-dire en faisant précéder votre texte dans une cellule du signe "=" (égal), et en mettant le texte entre guillemets, et en séparant chaque portion de texte destinée à une ligne différente, par le code suivant :

"&CAR(13)&"

CAR(13) étant la fonction CAR, utilisée avec le caractère ASCII "13" qui est celui du retour chariot.

Concrètement, supposons que dans une cellule D10, vous vouliez insérer la phrase ci-après figurant dans votre question, et la faire apparaître en 3 lignes (mais dans une seule cellule, la D10) :

J'ai crée une macro avec visual basic pour voir comment s'écrirait le code de ce formatage mais ne sais pas comment l'insérer dans le code proposé par Bebere

Il vous suffit dès lors de saisir dans la cellule D10 :

="J'ai crée une macro avec visual basic"&CAR(13)&" pour voir comment s'écrirait le code de ce formatage"&CAR(13)&" mais ne sais pas comment l'insérer dans le code proposé par Bebere"

J'espère que ça vous éclairera dans le sens que vous cherchiez.

Bonne continuation,

DomiB
 

Bebere

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

bonjour Melba,Domit
solution1 tu formates les cellules(centré,retour ligne) et tu employes ce code
à tester
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Couleur As Integer

    Application.EnableEvents = False

    If Target.Address = "$C$8" And Target.Count = 1 Then
        Couleur = Target.Interior.ColorIndex
        Select Case Target.Value
        Case ""
            Range("A10:G10").ClearContents
            Range("A10:G10").Interior.ColorIndex = xlNone
            With Range("E10")
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
            End With
        Case Else
            If Year(Target.Value) < 2012 Then
            Range("A10") = "jetons"
                Range("C10:G10").Clear
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10:G10").Interior.ColorIndex = -4142
                '                Formatrange
            End If

            If Year(Target.Value) >= 2012 Then
            Range("A10") = "jetons"
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10") = "mettre x si invité"
                Range("E10").Borders.Weight = xlThin
                '                Formatrange
            End If


        End Select

    End If

    If Target.Address = "$E$10" And Target.Count = 1 Then
        If Year(Range("C8").Value) >= 2012 And Target.Value = "x" Then
            Couleur = Range("C8").Interior.ColorIndex
            Range("A10") = "jetons"
            Range("C10").Interior.ColorIndex = Couleur
            Range("D10") = "mettre x si invité"
            Range("E10").Borders.Weight = xlThin
            Range("F10") = "cocktails"
            Range("G10").Interior.ColorIndex = Couleur
        End If
    End If
    Application.EnableEvents = True

End Sub
solution2
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Couleur As Integer

    Application.EnableEvents = False

    If Target.Address = "$C$8" And Target.Count = 1 Then
        Couleur = Target.Interior.ColorIndex
        Select Case Target.Value
        Case ""
            Range("A10:G10").Clear

        Case Else
            If Year(Target.Value) < 2012 Then
                Range("A10") = "jetons"
                Range("C10:G10").Clear
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10:G10").Interior.ColorIndex = -4142
                Formatrange
            End If

            If Year(Target.Value) >= 2012 Then
                Range("A10") = "jetons"
                Range("C10").Interior.ColorIndex = Couleur
                Range("D10") = "mettre x si invité"
                Range("E10").Borders.Weight = xlThin
                Formatrange
            End If


        End Select

    End If

    If Target.Address = "$E$10" And Target.Count = 1 Then
        If Year(Range("C8").Value) >= 2012 And Target.Value = "x" Then
            Couleur = Range("C8").Interior.ColorIndex
            Range("A10") = "jetons"
            Range("C10").Interior.ColorIndex = Couleur
            Range("D10") = "mettre x si invité"
            Range("E10").Borders.Weight = xlThin
            Range("F10") = "cocktails"
            Range("G10").Interior.ColorIndex = Couleur
        End If
    End If
    Application.EnableEvents = True

End Sub

Private Sub Formatrange()

    Range("A10").HorizontalAlignment = xlCenter
    Range("C10:G10").HorizontalAlignment = xlCenter
    Range("A10").WrapText = True
    Range("D10").WrapText = True
    Range("F10").WrapText = True

End Sub
 

job75

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

Bonjour melba, Bebere, Domib,

Il me semble que ce code suffit :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next 'sécurité
If Not IsDate([C8]) Then
  [A10:G10] = ""
Else
  [A10] = "jetons"
  If Year([C8]) < Year(Date) Then
    [D10,G10] = ""
  Else
    [D10] = "mettre x si invité"
    If UCase([E10].Text) = "X" Then
      [F10] = "cocktails"
    Else
      [E10:G10] = ""
    End If
  End If
End If
Application.EnableEvents = True
End Sub
Pour les mises en forme (couleurs, bordures) des cellules C10 E10 G10, il suffit de leur appliquer des Mises en forme conditionnelles (MFC).

Fichier joint.

Edit : j'ai inversé les MFC sur les 3 cellules.

A+
 

Fichiers joints

Dernière édition:

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonjour,

Un grand merci à tous, je vais tester vos propositions et vous tiens au courant.

@+
 

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonjour Bebere, Domit et Job75

J'ai testé les codes de Bebere mais ils ne fonctionnent pas ou alors cela vient de moi.

J'ai testé le code de Job75 : il fonctionne mais j'ai dû modifié les MFC conditionnelles car en réalité ma date de référence c'est 2003
Mais comme depuis le début j'avais donné une date fictive à 2012, pour ne pas compliquer les échanges je suis restée sur 2012;

Cela a forcément une incidence sur le fonctionnement du code de Job75.
Je l'ai modifié comme suit mais fonctionne partiellement.

Voici les problèmes rencontrés :
1) si je mets une date <2003, affiche "mettre x si invité" alors que ce message doit figurer seulement si la date est >= 01/01/2003

2) Si je mets une date >= 01/01/2003; tout va bien mais si aussitôt après je mets une date < 01/01/2003 ( sans effacer au préalable la date mise précédemment) , alors D10 à G10 non effacées.

Je dois obligatoirement enlever la date sinon les infos restent en D10:G10.

Merci encore pour votre contribution

Je joins un nouveau fichier test

@+
 

Fichiers joints

Dernière édition:

Fo_rum

XLDnaute Accro
Re : Aide pour modifier un code visual basic

Bonjour,

as-tu fait le tour de toutes les éventualités ?
Une autre proposition (sans MFC) dans laquelle j'ai rajouté un cas selon la saisie ou l'effacement du "x".
 

Fichiers joints

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonjour,

Merci pour ta proposition Fo rum mais cela ne va toujours pas ( désolée) :
Avec ton code, en G10 j'ai toujours un fond vert alors que cela doit être le cas uniquement si la date est >=01/01/2003 et quand j'ai x en E10;
Par ailleurs le problème que j'avais à la base avec le code de Bebere et le dernier de Job75 était surtout que toute les informations doivent figurer centrées dans les cellules et dans D10 et F10, comme j'aurai un texte assez long je dois avoir un formatage avec renvoi à la ligne;
Le dernier ficher de Job45 avec mises en forme conditionnelles était parfait pour les formats sauf que ne prenait pas en compte ( mais il ne pouvait pas le savoir) que la date de référence était 01/01/2003.
A part cette date j'avais fait le tour de toutes les conditions à respecter .
Je joins à nouveau mon fichier qui rappelle toutes les conditions.

Merci pour votre aide encore une fois

@+
 

Fichiers joints

Bebere

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

Melba
compare une année avec une date
If year([C8]) < "01/01/2003" Then
compare une date avec une date
If [C8] < "01/01/2003" Then
 

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonsoir Bebere et tous les autres,

Tenant compte de l'explication de Bebere je viens de modifier le code de Job75 comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next 'sécurité
If Not IsDate([C8]) Then
[A10:G10] = ""
Else
[A10] = "jetons"
If [C8] < "01/01/2003" Then
[D10,G10] = ""
Else
[D10] = "mettre x si invité xxxxxxxx"
If UCase([E10].Text) = "X" Then
[F10] = "cocktails xxxxxxxxxxxxxxxxxxxxxxxxxx"
Else
[E10:G10] = ""
End If
End If
End If
Application.EnableEvents = True
End Sub

Cela donne le résultat que j'attendais cependant il doit manquer un bout de code car le problème est le suivant :

Si je mets une date à 01/01/2002 par exemple : c'est ok

Si j'écris par dessus 01/01/2003 par exemple : c'est ok

Mais si j'écris par dessus à nouveau 01/01/2002 : cela n'efface pas les cellules E10 et F10 (?)

Encore un coup de pouce, on y est presque.

Si joins le fichier modifié

Encore un très grand merci à vous tous.
 

Fichiers joints

DomiB

XLDnaute Nouveau
Re : Aide pour modifier un code visual basic

Bonjour Melba,

Je m'aperçois en me relisant que j'ai omis que pour obtenir le retour à la ligne automatique, en utilisant la fonction CAR(13), il faut formater la ou les cellules concernées avec un alignement : Renvoyer à la ligne automatiquement (of course), mais qui donne un résultat bien plus agréable à lire que sans utiliser CAR(13).

Bonne continuation

DomiB
 

Bebere

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

bonjour
Melba ton code changé
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error Resume Next 'sécurité
If IsDate([C8]) Then
  [A10] = "jetons"
  If CDate([C8]) < CDate("01/01/2003") Then
    [D10:G10] = ""
  ElseIf CDate([C8]) >= CDate("01/01/2003") Then
  [D10] = "mettre x si invité xxxxxxxx"
    If UCase([E10].Text) = "X" Then
      [F10] = "cocktails xxxxxxxxxxxxxxxxxxxxxxxxxx"
    Else
      [E10:G10] = ""
    End If
  End If
Else
   [A10:G10] = ""
End If
Application.EnableEvents = True
End Sub
 
Dernière édition:

melba

XLDnaute Occasionnel
Re : Aide pour modifier un code visual basic

Bonjour,

Merci encore un énorme merci pour votre contribution à tous et votre patience, le code modifié par Bebere est nickel, j'ai exactement ce que j'attendais.
Je le comprends à peu près : seules les phrases suivantes me posent problème :

Application.EnableEvents = False
On Error Resume Next 'sécurité

End If
Application.EnableEvents = True

Que signifient-elles?

@+
 

Bebere

XLDnaute Barbatruc
Re : Aide pour modifier un code visual basic

bonjour Melba,le forum
curseur sur le mot(ex:EnableEvents) appui touche F1 appel aide
après lecture tu nous reviens si tu as besoin d'une explication
 

Discussions similaires


Haut Bas