Cellule coloriée si reactivé - Page 3

Résolu
Précédent
  • 1
  • 2
  • 3
  • 4
  • 5
  1. eric2027
     
    re

    toutes les cellules seraient soumises aux mêmes critères, et même se verrouiller lorsque leurs valeurs changent une fois.

    est ce que je peux mettre "attention"en rouge à la place de ce que tu m'as mis comme avertissement

    merci

    Éric
    0
  2. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    Alors le code est bien plus simple et dans la Thiswokbook, il se limite à

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopClign
    End Sub

    Private Sub Workbook_Open()
    Call StopClign
    Call Clign
    End Sub

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not Intersect([B9:B39,C9:C39,D9:D39,E9:E39,F9:F39,G9:G39,H9:H39,I9:I39,J9:J39], Target) Is Nothing Then
    Target.Offset(0, 9) = Target.Offset(0, 9) + 1
    If Target.Offset(0, 9) >= 2 Then
    Target.Interior.ColorIndex = 38
    If Target = "" Then
    Target.Offset(0, 9) = ""
    Target.Interior.ColorIndex = xlNone
    End If
    End If
    End If
    Call Protection_Cellule_Couleur
    Call StopClign
    Call Clign
    End Sub

    https://www.cjoint.com/?0kjxdPvE8XA
    0
  3. eric2027
     
    re
    j'ai testé c super cool,

    et si je veux que les cellules se bloque à la 1ère manip, je fais "If Target.Offset(0, 9) >= 1 Then "

    je suis ô début de la connaissance

    ô grand merci

    Éric
    0
    1. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
       
      Tout à fait,

      If est la conditionnelle si

      Target est la cellule active dans laquelle tu viens de saisir une valeur.

      Offset(0, 9) est un décalage par rapport à la cellule active changement de 0 ligne, changement de 9 colonne positive donc vers la droite

      >=1 si la cellule Offset (cellule décalée de 9 colonnes par rapport à la cellule active) contient une valeur

      Then alors la condition
      0
  4. eric2027
     
    bonjour Mike

    j'essaie de prendre les données de ta feuille pour les mettre dans mon fichier
    mais cela ne fonctionne pas.

    je ne vois pas de macro quand je veux visualiser ton code, est ce normal ?

    les autres colonnes ne se colories pas, j'ai beau chercher, je ne trouve pas

    Éric
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    Un code VBA ne se modifie pas comme une formule que l'on déplace, il faut intervenir sur le code.
    Pour te permettre de l'adapter plus facilement, j'ai apporté quelques modifications.

    Si tu es sur Excel 2003
    Sur ta feuille de calcul, comment par déverrouiller tes cellules que tu souhaites laisser accessibles et obligatoirement de K9 à S39 de B9 à J39 et B40 (lorsque la feuille est déprotégée mets en surbrillance ces plage et Format/Cellule/onglet Protection, décoche Verrouiller)

    Ensuite dessine ta Shape à partir de ta barre de dessin/Formes Automatiques/sélectionne la forme de ton choix
    Clic droit sur la forme et Format de la forme Automatique/onglet Traits et couleurs pour mettre un fond
    Clic droit de nouveau sur ta forme/Ajouter du texte, saisis le texte souhaité
    Clic droit de nouveau sur le texte Format de la forme Automatique paramètre ton texte couleur, police, gras etc ...

    Une fois ta Shape terminée clic sur la Shape, tu verras dans la barre d'adresse juste au dessus de l'entête de colonne A le nom de la Shape, clic dessus, elle se mettra en surbrillance, saisis au clavier en respectant la majuscule Alerte

    Clic droit sur l'onglet de feuille/Visualiser le code (ce qui t'ouvrira le visual basic)
    Dans la marge de gauche tu trouveras Thiswokbook (double clic dessus ou clic et touche Entrée. Colle dans la partie blanche de droite ce code

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopClign
    End Sub

    Private Sub Workbook_Open()
    Call StopClign
    Call Clign
    End Sub

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not Intersect([B9:B39,C9:C39,D9:D39,E9:E39,F9:F39,G9:G39,H9:H39,I9:I39,J9:J39], Target) Is Nothing Then
    Target.Offset(0, 9) = Target.Offset(0, 9) + 1
    If Target.Offset(0, 9) >= 2 Then
    Target.Interior.ColorIndex = 38
    If Target = "" Then
    Target.Offset(0, 9) = ""
    Target.Interior.ColorIndex = xlNone
    End If
    End If
    End If
    Call Protection_Cellule_Couleur
    Call StopClign
    Call Clign
    End Sub

    Ensuite Insertion/Module ce qui générera un module juste au dessus de la Thiswokbook qui senommera Module1 si c'est le premier ou 2 si c'est le deuxième etc ...
    Double clic sur le Module ou clic et Entrée pour l'ouvrir colle ce code

    Dim Temps As Variant

    Public Sub Clign()
    'Programmation de l'évènement toutes les secondes
    Temps = Now + TimeValue("00:00:01")
    Application.OnTime Temps, "Clign"
    If [B40] >= 11 Then
    With ThisWorkbook
    'Texte clignotant
    With .ActiveSheet
    .Shapes("Alerte").Visible = Not .Shapes("Alerte").Visible
    End With
    With .ActiveSheet.[B40]
    [B40].Font.ColorIndex = IIf(.Font.ColorIndex = 2, 1, 2)
    [B40].Font.FontStyle = "Gras"
    [B40].Font.Size = 12
    End With
    'Fond clignotant
    With .ActiveSheet.[B40]
    .Interior.ColorIndex = IIf(.Interior.ColorIndex = 1, 2, 1)
    End With
    End With
    End If
    End Sub

    Public Sub StopClign()
    On Error Resume Next
    'Stoppe la gestion de l'évènement OnTime
    Application.OnTime Temps, "Clign", , False
    On Error GoTo 0
    'Cache l'alerte
    With ThisWorkbook
    'Fond
    .ActiveSheet.[B40].Interior.ColorIndex = xlNone
    'Texte
    .ActiveSheet.[B40].Font.ColorIndex = 0
    [B40].Font.FontStyle = "Normal"
    [B40].Font.Size = 10
    End With
    ActiveSheet.Shapes("Alerte").Visible = False
    End Sub

    Sub Protection_Cellule_Couleur()
    Dim cel As Range
    ActiveSheet.Unprotect Password:="leg509"
    For Each cel In [B9:B39,C9:C39,D9:D39,E9:E39,F9:F39,G9:G39,H9:H39,I9:I39,J9:J39]
    If cel.Interior.ColorIndex = 38 Then
    cel.Locked = True
    End If
    Next
    ActiveSheet.Protect Password:="leg509", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True
    End Sub

    Enregistre ton fichier et tout doit fonctionner. Sinon il faudra me le faire parvenir en message privé pour que je l'adapte
    0
  7. eric2027
     
    re

    ça ne fonctionne pas, comment je fais pour te l'envoyer en message privé, j'ai deja mis un fichier dans cjoint

    Éric
    0
  8. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Je ne vois pas ton fichier dans la discussion, pour l'envoyer s'il ne contient pas de notes confidentielles, tu clic sur ce lien

    https://www.cjoint.com/

    Parcourir/sélectionne ton fichier/clic sur créer le lien

    colle le lien généré sur un post ou sur un message privé pour cela clic sur mon pseudo dans la discussion et message privé
    0
  9. eric2027
     
    re

    je viens de mettre mon fichier sur cjoint, il s'appelle "eric"
    0
  10. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Tu n'as pas collé le lien généré, donc pas de fichier.

    Recommence, clic sur ce lien
    https://www.cjoint.com/
    ensuite sur Parcourir pour sélectionner ton fichier
    Clic sur créer le lien
    mets en surbrillance le lien bleu généré en haut de la page, clic droit dessus/copier
    vas sur le post que tu veux m'envoyer et clic droit coller
    0
  11. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    un post c'est chaque message d'une discussion, je te répond par l'intermédiaire d'un post, ce message est un post ou une réponse
    0
  12. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    C'est bon je viens de récupérer ton fichier,

    Le 9/10 à 20h55 tu écrivais dans un pos
    pour moi c'est plus simple de pouvoir gérer les colonne B; C; D; E; F; G; H; I; J, dans la même macro

    Alors soyons bien clair, tu veux que dans tes colonnes B, D, F et G se bloquent lors de la deuxième saisie !

    Tu me demande de bloquer la cellule en bleu soit la C42, qui aura t il dedans une formule !

    Que doit il se passer colonnes C, E, G et colonnes I et J !

    Il était également question de faire clignoter une cellule la B40 lorsque sa valeur atteignait 11 !

    qui aura til enE42 ainsi qu'en C43 !
    0
  13. eric2027
     
    re

    je récap, je me suis planté,

    pour les colonnes, BCDE, les chiffres avec possibilité que 2 changement maxi, avec couleur 38, il n'y aura que la b40 clignotante en en noir sur chiffre blanc 11

    pour les colonnes FG, ce sera du textes, pour t'on les bloquer avec possibilité que 2 changement maxi avec couleur 38

    je ne mets aucune formule, si cela est possible, est ce que je pourrais des changements dansla macro ?

    crois tu que je peux faire évoluer ce fichier en y incorporant des mfc

    le mot de passe est "leg509"

    merci pour tout

    Éric
    0
  14. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    récupère ton fichier voir s'il répond à tes attentes

    https://www.cjoint.com/?0klpswGNYTq

    A+
    Mike-31

    Une période d'échec est un moment rêvé pour semer les graines du savoir.
    0
  15. eric2027
     
    re

    il y a un petit souci, les lignes 23à27 sont bloquées sur toutes les colonnes, comment je fais pour les débloquées,

    sinon, je dirai que c vraiment parfais c'est vraiment ce que je voulais

    encore merci

    Éric
    0
  16. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    Bizarre sur mon fichier tout est bon, voila le fichier contrôlé

    https://www.cjoint.com/?0klpQqBkMj

    Autrement pour déverrouiller des cellules, il faut commencer par déprotéger la feuille
    Outils/Protection avec ton mot de passe leg509
    ensuite mettre la ou les cellules à déverrouiller en surbrillance et
    Format/Cellule/onglet Protection/décocher Verrouillée

    ne pas oublier de reprotéger la feuille sans se tromper sur la saisie du mot de passe sinon le code macro plantera
    Outils/Protection avec ton mot de passe leg509

    A+
    Mike-31

    Une période d'échec est un moment rêvé pour semer les graines du savoir.
    0
  17. eric2027
     
    re

    c'est nickel chrome, j'ai du faire une mauvaise manip

    maintenant, je dis que c résolu sur le message que que tu m'as envoyé

    merci encore

    Éric
    0
  18. eric2027
     
    bonjour Mike

    je viens encore t'ennuyer avec ma feuille, je voudrais faire 2 classeur avec sur le 1er, décembre 2010, le 2ème janvier 2011, je voudrais que les liens se fassent automatiquement parce que sur la cellule c42 du 1er classeur, il y aura un chiffre qui doit se répercuter en c42 sur le 2ème classeur, là j'ai réussi avec des liens mais il faut que j'ouvre le 1er classeur pour que cela fonctionne, donc est ce qu'il y a une possibilité pour ne pas ouvrir le 1er fichier

    merci

    Éric
    0
  19. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Oui tout à fait, par code VBA il faut que les deux classeurs soit dans le même répertoire

    Nomme la cellule C42 du fichier 1 exemple Source

    dans la Thiswokbook du module Visual Basic

    Tu as ce code

    Private Sub Workbook_Open()
    Call StopClign
    Call Clign
    End Sub

    il faut rajouter
    Dim chemin As String
    chemin = "'" & ThisWorkbook.Path & "\\"
    Range("C42") = ExecuteExcel4Macro(chemin & "\\NOM DU PREMIER CLASSEUR.xls'!source")

    ce qui te donnera

    Private Sub Workbook_Open()
    Dim chemin As String
    chemin = "'" & ThisWorkbook.Path & "\\"
    Range("C42") = ExecuteExcel4Macro(chemin & "\\NOM DU PREMIER CLASSEUR.xls'!source")
    Call StopClign
    Call Clign
    End Sub

    A la création ouvres les deux fichiers

    A+
    Mike-31

    Une période d'échec est un moment rêvé pour semer les graines du savoir.
    0
Précédent
  • 1
  • 2
  • 3
  • 4
  • 5