Microsoft 365 Ouverture automatique d'un Popup à l'ouverture d'un fichier Excel...

[WEIDER]

Bonjour à toutes et tous,

Pourriez-vous m'aider à solutionner mon problème, ou plus exactement ma demande ? Perso je suis hélas dépassé par sa complexité...

Tout est expliqué dans mon fichier joint...

Vraiment, mille mercis à tous pour votre aide précieuse !!!

Amicalement

Pascal.

 

[Compte Supprimé 979]

Bonjour Weider,

Pourquoi ne pas mettre la demande dans un 1er temps dans votre post

Je voudrais qu'en ouvrant mon fichier Excel 'IPP - Suivi', une boite d'alerte s'ouvre au milieu de mon écran m'indiquant les N° d'IPP à traiter, selon.
--> les IPP ayant la date du jour OU une date dépassée (colonne 'O' Date d'application) !
--> ET, ne pas prendre en compte les ligne ayant 'OK' en colonne 'Q' !
Voir l'exemple d'un Popup à droite.

Ensuite pour y répondre, code à mettre dans ThisWorkbook

Private Sub Workbook_Open()
  ' Appeler la sub pour afficher le popup
  Call PopUp
End Sub

Code à mettre dans un module

Option Explicit

Sub PopUp()
  Dim dLig As Long, Lig As Long
  Dim Msg As String
  ' Début du message
  Msg = "Attention IPP à traiter !" & vbCr & vbCr
  ' Avec la feuille
  With Sheets("Sommaire IPP")
    ' Dernière ligne remplie
    dLig = .Range("O" & Rows.Count).End(xlUp).Row
    ' Parcourir les lignes
    For Lig = 5 To dLig
      If .Range("O" & Lig).Value = "" Then GoTo SuiteLig
      If .Range("O" & Lig).Value <= Date And .Range("Q" & Lig).Value = "" Then
        Msg = Msg & Range("A" & Lig) & " IPP " & Range("B" & Lig) & " a atteint ou dépassé la date d'application" & vbCr
      End If
SuiteLig:
    Next Lig
  End With
  MsgBox Msg, vbCritical, "ATTENTION IPP A TRAITER..."
End Sub

@+

 

[chris]

Bonjour à tous

Une autre approche avec des données sous forme de tableau structuré et une restitution des éléments à traiter par PowerQuery avec l'affichage, le cas échéant géré, par VBA

 

[job75]

Bonjour WEIDER, Bruno, chris,

Une autre solution qui utilise une feuille auxiliaire pour afficher le message, le code dans ThisWorkbook :

Dim F As Worksheet, CelModel As Range 'mémorise les variables

Private Sub Workbook_Open()
Dim c As Range, tablo, i&, flag As Boolean, x$, y$
Set F = Sheets("Message") 'feuille auxiliaire
Set CelModel = F.[H12] 'dont la ligne est masquée
CelModel(2).Resize(F.Rows.Count - CelModel.Row).EntireRow.Delete 'RAZ
Set c = CelModel(2)
F.Visible = xlSheetHidden 'xlSheetVeryHidden
tablo = Sheets("Sommaire IPP").[A5].CurrentRegion.Resize(, 17) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 6)) And UCase(tablo(i, 17)) <> "OK" Then
        If Date >= tablo(i, 6) Then
            flag = True
            CelModel.MergeArea.Copy c
            x = tablo(i, 1): y = "IPP " & tablo(i, 2)
            c.Replace "xxx", x, xlPart
            c.Replace "yyy", y
            c.Replace "zzz", Format(tablo(i, 6), "dd/mm/yyyy")
            c.Characters(Len(x) + 2, Len(y)).Font.Color = vbRed 'police rouge
            Set c = c(2) 'incrémentation
        End If
    End If
Next
If flag Then Application.OnTime 1, "ThisWorkbook.Affiche" 'exécution différée
End Sub

Sub Affiche()
Dim duree#, t#
duree = 10 'temporisation en secondes, à adapter
Application.ScreenUpdating = False
F.Visible = xlSheetVisible
Application.Goto F.[A1] 'cadrage
CelModel(-1).Select
Application.ScreenUpdating = True
t = Timer + duree
While Timer < t And t < 86400: DoEvents: Wend
F.Visible = xlSheetHidden 'xlSheetVeryHidden
End Sub

A+

 

[WEIDER]

Merci à tout les deux pour votre aide, c'est très sympa d'y avoir consacré de votre temps.

J'ai opté pour ta solution Bruno ! Merci à toi.

Excellente journée à vous deux.

Pascal.

 

[job75]

Merci à tout les deux

Nous sommes 3 à avoir répondu

 

[Compte Supprimé 979]

@job75 oui mais Chris est à fond PQ
Perso, j'appelle ça du sectarisme

 

[WEIDER]

Hé oui, notre ami Job est intervenu juste après ma réponse !

Merci à T.O.U.S !

 

[job75]

Hé oui, notre ami Job est intervenu juste après ma réponse !

52 minutes avant

 

[job75]

Si vous ne voulez pas d'une temporisation voyez ce fichier (2) et le bouton Fermer :

Sub Affiche()
Application.ScreenUpdating = False
F.Visible = xlSheetVisible
Application.Goto F.[A1] 'cadrage
CelModel(-1).Select
End Sub

Sub Ferme()
F.Visible = xlSheetHidden 'xlSheetVeryHidden
End Sub

 

[chris]

RE

@job75 oui mais Chris est à fond PQ
Perso, j'appelle ça du sectarisme

J'ai mélangé les 2 pour une fois, donc je suis un peu bi...