Afficher commentaire quand la cellule répond à une condition

K

kaiser

XLDnaute Occasionnel
Voila j'ai un programme qui permet de remplir un fichier annexe en fonction de certaines conditions: c'est à dire que quand il trouve une case jaune ou rose, il remplit automatiquement le fichier annexe et me demande à chaque fois 2 informations via une input box.
Seulement parfois pour pouvoir bien répondre aux question du programme j'ai besoin de voir les commentaires de ces cellules coloriées (toutes n'ont pas de commentaires)
.
J'ai trouvé le code, mais je ne sais pas comment le mettre.

Code: 
For Each Cell In plage_date
    If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
    flag = True
    Cell.Comment.Visible = True

si je le met comme ca il me dis:
Error runtime "91"
Object variable or with bloc variable not set

je pense que ce doit être un truc tout con mais vu que je suis débutant je vois pas c'est quoi
 
Trier par date Trier par votes
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Afficher commentaire quand la cellule répond à une condition

Bonjour à tester et adapter

Sub e()
Dim cell As Range
'zone balayée
plage_date = Range("A1:A3").Address
'regarde chaque cellule
For Each cell In Range(plage_date)
MsgBox cell.Interior.ColorIndex
If cell.Interior.ColorIndex = 6 Or cell.Interior.ColorIndex = 38 Then
If Not cell.Comment Is Nothing Then cell.Comment.Visible = True

End If
Next
End Sub
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

yep ca marche impeccable!

merci a toi!

me reste juste a placer mon "Application.ScreenUpdating = False" ou il faut pour pas avori l'afficahge qui tremblott mais en ayant la possibilité de voir les commentaires
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

Bonjour le forum

J'ai toujours un petit probléme avec mon probléeme de commentaires:
ca marche comme je veut seulement lorsque je lance le programme pour chaque ligne "scannée" par le programme l'écram "clignote", de quoi faire une crise d'épilepsie!
Moi je voudrais que pendant toute la durée de programme je reste sur le fichier 2007Schicht.xls avec a chaque case trouvée le commentaire qui s'affiche.

Le code
Code: 
feuille = ActiveSheet.Name

For n = 9 To Range("B65536").End(xlUp).Row Step 3
If n = 30 Then n = 33
Workbooks.Open "c:\Documents And Settings\diaquint\My Documents\rpl.xls"
Workbooks("2007Schicht2modif1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)
Application.ScreenUpdating = True
i = 6

   For Each Cell In plage_date
    If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
Application.ScreenUpdating = True
    [COLOR="Red"]If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = True[/COLOR]
    flag = True
    
    'Application.ScreenUpdating = False
    
i = i + 1
    nom = Range("B" & n)
    prenom = Range("B" & n + 1)
    Workbooks("rpl.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
    Workbooks("rpl.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
    Workbooks("rpl.xls").Sheets("sheet1").Range("E28") = "Fait le " & Date
    Workbooks("rpl.xls").Sheets("sheet1").Range("E28").Font.Bold = True
    heure = Cell.Value
    jour = Cells(6, Cell.column)
     
         Select Case feuille
         ....
         End Select
         
    Workbooks("rpl.xls").Worksheets("sheet1").Range("G3") = mois
    With Workbooks("rpl.xls").Worksheets("sheet1").Range("G3").Font
    .Bold = False
    .Italic = False
    .Underline = False
    End With
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 2) = heure
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 4) = jour & " " & mois

    remplace = InputBox("Entrez le nom de la personne remplacée le " & jour & " " & mois & " par " & prenom & " " & nom, "Remplacement", lastname, 9960, 330)
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 5) = remplace
    lastname = remplace
    If Cell.Interior.ColorIndex = 38 Then
    poste = "Neutra"
    Else
    poste = InputBox("Entrez le poste", "Remplacement", lastposte, 9960, 330)
    lastposte = poste
    End If
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 6) = poste
    'explication = InputBox("Entrez les explications du remplacement", "Remplacement", "", 9960, 330)
    'Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 7) = explication
    If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = False
 End If
Next Cell
If flag Then
Workbooks("rpl.xls").Activate
Workbooks("rpl.xls").SaveAs Filename:="remplacement " & mois & " " & nom
End If
flag = False
Next n
Workbooks("2007Schicht2modif1.xls").Activate
Application.ScreenUpdating = True
Workbooks("rpl.xls").Close
reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
If reponse = 7 Then

End If
End If
End Sub
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Afficher commentaire quand la cellule répond à une condition

re

tu enlèves tes
Application.ScreenUpdating = False
du début de programme car autorise l'affichage

tu mets
Application.ScreenUpdating = False
après feuille=....

a tester
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

J'ai pas bien compris ce que tu as dis, tu pourrais detailler un poil plus stp?

En fait je veut desactiver la "mise a jour de l'écran" tout le temps, sauf au moment d'afficher les commentaires ( si il y en a)

Merci
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Afficher commentaire quand la cellule répond à une condition

re

feuille = ActiveSheet.Name
Application.ScreenUpdating = false

For n = 9 To Range("B65536").End(xlUp).Row Step 3
If n = 30 Then n = 33
Workbooks.Open "c:\Documents And Settings\diaquint\My Documents\rpl.xls"
Workbooks("2007Schicht2modif1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)
i = 6

........

Workbooks("rpl.xls").Close
Application.ScreenUpdating = True
reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
If reponse = 7 Then

End If
End If
End Sub
​
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

oki impeccable ca marche! Merci à toi!

J'ai une autre question: dans ce même classeur excel j'ai des formules dans un modules permettant de faire des sommes en fonction de la couleur de la case ou de la police, seulement si je met Application.Volatile ca ralentit au taquet l'execution du programme (surement parceque il recalcule a chaque fois) et si je ne le met pas ben ca ne recalcule jamais (même en appuyant sur F9)
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Afficher commentaire quand la cellule répond à une condition

re

A mon avis ouvre un autre fil et joins un exemple

cela peut passer par une optimisation de code,
un déclenchement de macro à l'activation de la feuille,
un déclenchement par bouton....

tout dépend de l'appli
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

J'ai un ptit probléme avec mon histoire de commentaire
En fait j'ai voulu deplacer une petite partie de mon code (partie verte) parceque suite a une boulette de ma part il repetait la même opération plusieurs fosi de suite.
Seulement en haut du programme si je supprime la derniére ligne (celle sans apostrophe) les commentaires ne s'affichent plus!
Alors que apparement ca a aucun rapport.

Un ptit coup de pouce pour me debloquer serais le bienvenue
Code: 
Private Sub CommandButton1_Click()

Dim Cell As Range
Dim flag As Boolean
Dim myarray(10) As String

feuille = ActiveSheet.Name
Application.ScreenUpdating = False

For n = 9 To Range("B65536").End(xlUp).Row Step 3
If n = 30 Then n = 33
Workbooks.Open "C:\Documents and Settings\XXXXX\My Documents\rpl.xls"
Workbooks("2007Schicht2modif1.xls").Activate
Set plage_date = Range("D" & n & ":AG" & n)

i = 6

   For Each Cell In plage_date
    If Cell.Interior.ColorIndex = 6 Or Cell.Interior.ColorIndex = 38 Then
    Application.ScreenUpdating = True
    Application.Calculation = xlManual
    'Application.EnableEvents = False
    If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = True
    flag = True
    
        
i = i + 1
    nom = Range("B" & n)
    prenom = Range("B" & n + 1)
    [COLOR="Lime"]'Workbooks("rpl.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
    'Workbooks("rpl.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
    'Workbooks("rpl.xls").Sheets("sheet1").Range("E30") = "Fait le " & Date
    Workbooks("rpl.xls").Sheets("sheet1").Range("E30").Font.Bold = True[/COLOR]
    heure = Cell.Value
    jour = Cells(6, Cell.column)
     Application.ScreenUpdating = False
         Select Case feuille
         ...
         End Select
         
    Workbooks("rpl.xls").Worksheets("sheet1").Range("G3") = mois
    With Workbooks("rpl.xls").Worksheets("sheet1").Range("G3").Font
    .Bold = False
    .Italic = False
    .Underline = False
    End With
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 2) = heure
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 4) = jour & " " & mois

    remplace = InputBox("Entrez le nom de la personne remplacée le " & jour & " " & mois & " par " & prenom & " " & nom, "Remplacement", lastname, 9960, 330)
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 5) = remplace
    lastname = remplace
    If Cell.Interior.ColorIndex = 38 Then
    poste = "Neutra"
    Else
    poste = InputBox("Entrez le poste", "Remplacement", lastposte, 9960, 330)
    lastposte = poste
    End If
    Workbooks("rpl.xls").Worksheets("sheet1").Cells(i, 6) = poste
    If Not Cell.Comment Is Nothing Then Cell.Comment.Visible = False
 End If
Next Cell
If flag Then

   [COLOR="Lime"]Workbooks("rpl.xls").Sheets("sheet1").Range("E4") = prenom & " " & nom
    Workbooks("rpl.xls").Sheets("sheet1").Range("E4").Borders.LineStyle = xLineStyleNone
    Workbooks("rpl.xls").Sheets("sheet1").Range("E30") = "Fait le " & Date
    Workbooks("rpl.xls").Sheets("sheet1").Range("E30").Font.Bold = True[/COLOR]
Filename = "remplacement " & mois & " " & nom & ".xls"
Workbooks("rpl.xls").SaveAs Filename:=Filename
myarray(j) = Filename
j = j + 1
End If
flag = False
Next n
'Workbooks("2007Schicht2modif1.xls").Activate
Workbooks("rpl.xls").Close
'Application.ScreenUpdating = True
Application.EnableEvents = True

reponse = MsgBox("Voulez-vous imprimer les fiches de remplacements?", vbYesNo + vbQuestion, "Impression Fiche de Remplacement")
If reponse = 6 Then
    j = 0
    Do Until myarray(j) = ""
    Workbooks(myarray(j)).PrintOut
    j = j + 1
    Loop
End If

Line1:
Application.Calculation = xlAutomatic
End Sub
[COLOR="Lime"][/COLOR]

Merci
 
Vote positif 0 Vote négatif
Toine

Toine

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

peut étre que s'est parcque ton classeur sactive avec cette ligne tu a éssailler de remplacer ta ligne par .activate
ou un truc du genre autrement je voit pas trop a vrai dire
 
Vote positif 0 Vote négatif
K

kaiser

XLDnaute Occasionnel
Re : Afficher commentaire quand la cellule répond à une condition

yep bien vu l'ami!

encore une fois merci à toi!

bon ben le programme est finis, me reste plus qu'a attaquer mon rapport maintenant, faut que je le rende jeudi (mode stressé:ON).

Reste dans le coin Toine dans le rapport faudra que je l'explique ligne par ligne...:p
 
Vote positif 0 Vote négatif

Discussions similaires

xUpsilon
  • Question
Autres Permettre à une macro définie avec une bibliothèque d'objet récente de tourner avec une bibliothèque d'objets antérieure
Réponses
3
Affichages
1 K
Hasco
Hasco
Magic_Doctor
  • Question
XL 2010 Une fonction qui sature
Réponses
8
Affichages
1 K
Magic_Doctor
Magic_Doctor
S
  • Question
Provoquer une erreur après l'ouverture d'un fichier si la condition pas respectée
Réponses
12
Affichages
1 K
shenmicke
S
P
  • Question
erreur 91 peut être une variable objet en Nothing ?
Réponses
3
Affichages
2 K
skoobi
skoobi
K
  • Question
Imprimer fichier créé par un programme vba
2 3 4
Réponses
55
Affichages
5 K
kaiser
K
K
  • Question
Ne pas recalculer les functions d'un module lors de l'execution d'une macro
2
Réponses
17
Affichages
2 K
kaiser
K
K
  • Question
Exécution trés lente d'une macro
Réponses
10
Affichages
2 K
porcinet82
porcinet82

Membres actuellement en ligne

9 membres et 113 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 223
Messages
2 086 407
Membres
103 201
dernier inscrit
centrale vet