SOS VBA

SOS VBA - VB/VBA/VBS - Programmation

Marsh Posté le 25-01-2019 à 04:05:21    

Bonjour les amis, il est 03h45 et je cherche encore la solution à mon problème! je viens donc demander votre aide
 
Voici ma macro de depart
 
Sub date_jour()
Dim la_date As Variant
Dim i As Integer
Dim j As Integer
Dim c As Integer
 
ActiveSheet.Unprotect "#######"
 
    For i = 2 To Range("H" & Rows.Count).End(xlUp).Row
   
     
        If IsDate(Cells(i, 8)) Then
   
         
   
   If Cells(i, 8) <= Date + 15 And Cells(i, 10) <> "NON" And Cells(i, 11) <> "NON" Then
         
         
             
             
            Cells(i, 15).Select
            ActiveCell = "ALERTE 2"
            ActiveCell.Font.ColorIndex = 3
            ActiveCell.Font.Bold = True
            ActiveCell.Font.Italic = True
            ActiveCell.Select
                    Call alerte_info
                     
                Cells(i, 8).Select
                    Call clignotte
        End If
            End If
               
               
               
                 
       
         
         
        If Cells(i, 8) <= Date + 15 And Cells(i, 10) = "NON" Then
                 
                Call condition_nul
                 
                 Cells(i, 8).Select
                    Call clignotte
                     
                End If
                     
                       
                       
                       
         
        If Cells(i, 8) <= Date + 15 And Cells(i, 11) = "NON" Then
                 
                Call condition_nul
                 
                 Cells(i, 8).Select
                    Call clignotte
                     
                 
                    End If
                         
                            Next i
                 
                 
 ActiveSheet.Protect "######"
 
 
End Sub
 
 
Et voici la macro imbriguée  
 
 
Sub clignote()
Dim ma_ligne As Long
Dim ma_plage As Object
 
ma_ligne = ActiveCell.Row
 
Set ma_plage = Range(Cells(ma_ligne, 1), Cells(ma_ligne, 14))
 
 
    [ma_plage].Interior.Color = vbWhite
 
 
Do While Not IsEmpty([ActiveCell])
        If [ma_plage].Interior.Color = vbRed Then
            [ma_plage].Interior.Color = vbWhite
        Else
            [ma_plage].Interior.Color = vbRed
        End If
        DoEvents
      Call Wait
             
    Loop
 Exit Sub
    [ma_plage].Interior.Color = vbWhite
End Sub
 
 
Sub Wait()
' Attendre 5 secondes
Application.Wait Time + TimeSerial(0, 0, 1)
' Continuer après la pause
End Sub
 
 
Le souci est que lorsque la première condition de la macro date_jour() est vérifié et que automatiquement la macro clignote() se déclenche,étant donnée qu'elle est une boucle, le next i n'est plus pris en compte et ma macro date_jour est en arrêt.
 
Je souhaiterais que toutes les cellules de la colonne en question, c'est a dire de 2 to  Range("H" & Rows.Count).End(xlUp).Row qui repondent aux conditions "if..." clignotent en même temsp! Comment je dois m y prendre? J'ai essaye avec un tableau mémorisé mais j'ai vraiment du mal à avancer!
 
Merci d'avance pour celui ou ceux qui me viendront en aide!

Reply

Marsh Posté le 25-01-2019 à 04:05:21   

Reply

Marsh Posté le 25-01-2019 à 10:04:27    

Bonjour,
 
Je n'ai pas tout lu en détail, mais dans le principe, tu listes d'abord toutes les cellules à faire clignoter puis une fois que tu fais ça tu appelles ta macro de clignotement pour toutes les cellules listées.


---------------
C'est en écrivant n'importe quoi qu'on devient n'importe qui.
Reply

Marsh Posté le 25-01-2019 à 11:21:22    

Bonjour,
 
justement comment lister toutes les cellules sachant qu'elles répondent à des conditions! la liste est aléatoires

Reply

Marsh Posté le 25-01-2019 à 11:38:54    

Tu parcoures tes cellules à analyser, une fois qu'une cellule répond à une condition tu l'ajoutes à une collection ou un tableau et tu passes à la cellule suivante. Une fois que toutes les cellules à analyser ont été testées tu parcoures ta collection et tu fais clignoter chaque cellule.


---------------
C'est en écrivant n'importe quoi qu'on devient n'importe qui.
Reply

Marsh Posté le 25-01-2019 à 12:08:17    

Je ne sait pas comment le faire! j'ai vraiment du mal avec l'utilisation des tableau en mémoire... et comment parcourir celle-ci?
 
Peux tu me donner un exemple à partir du quelle je vais ma baser pour l'adapter à mon cas!

Reply

Marsh Posté le 25-01-2019 à 18:35:00    

Code :
  1. Option Explicit
  2.  
  3.  
  4. Sub changeBackgroundColor()
  5.    Dim i As Integer
  6.    Dim k As Integer
  7.    Dim cellules As New Collection
  8.    Dim maligne As Variant
  9.    
  10.    With ThisWorkbook.Sheets(1)
  11.        k = .Cells(1, 1).End(xlDown).Row
  12.        For i = 1 To k
  13.            If .Cells(i, 1) <> "" Then
  14.                cellules.Add (i)
  15.            End If
  16.        Next i
  17.        For Each maligne In cellules
  18.            .Cells(maligne, 1).Interior.ColorIndex = 3
  19.        Next
  20.    End With
  21. End Sub
 

Ce code change en rouge la couleur de fond des cellules non vides, il utilise une collection, moins compliqué mais probablement plus gourmand que l'utilisation d'un tableau. :hello:


Message édité par MaybeEijOrNot le 25-01-2019 à 18:37:57

---------------
C'est en écrivant n'importe quoi qu'on devient n'importe qui.
Reply

Marsh Posté le 25-01-2019 à 21:27:29    

Public Sub clign()
Dim temps As Variant
Dim fin As Long
Dim i As Integer
Dim j As Integer
 
 
ActiveSheet.Unprotect "#####"
       
         
   Call DEVIS
   Call PEC
     
temps = Now + TimeValue("00:00:01" )
Application.OnTime temps, "Clign"
     
        With ActiveSheet
 
                    fin = Range("H" & Rows.Count).End(xlUp).Row
         
                        For i = 4 To fin
                            If IsDate(Cells(i, 8)) Then
                            If Cells(i, 8) <= Date + 15 Then
                                Cells(i, 15) = "Alerte PEC - 15 jours"
                                Cells(i, 15).Font.ColorIndex = 3
                                Cells(i, 15).Font.Bold = True
                                Cells(i, 15).Font.Italic = True
                                 
                     
                            With Range(Cells(i, 1), Cells(i, 14))
                            .Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, 0, 3)
                        End With
                    End If
                End If
            Next i
 
   
     
     End With
     
     
     ActiveSheet.Protect "#####"
     
End Sub
 
 
 
Après une longue journée d'acharnement j'ai finalement trouvé la solution et je remercie infiniment MaybeEijOrNot qui m'a mis sur la voie
 
Je suis vraiment fier d’être membre de ce groupe

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed