Microsoft 365 Boite de dialogue suivant date et récupération de données

chnico80 · 24 Mars 2023

Bonjour à tous,

nouveau sur le forum, je viens vous solliciter pour résoudre un problème.

J'aimerais pouvoir avoir une boite de dialogue qui s'affiche à l'ouverture du fichier quand la date de diffusion est égale à la date du jour.
Dans cette boite de dialogue, j'aimerais également récupérer le N° d'affaire ainsi que le nom d'affaire associé.
Dans le fichier ci joint, par exemple, le 30/03/2023 à l'ouverture du fichier, que j'ai un message me disant :

Diffusion du jour :
789123 test2
124582 test3

J'ai essayé via VBA mais je ne m'y connais pas assez.

Par avance merci

Dranreb · 24 Mars 2023

VB:

Option Explicit
Private Sub Workbook_Open()
   Dim TD(), L As Long, TM() As String, LM As Long
   TD = Feuil1.ListObjects(1).DataBodyRange.Value
   ReDim TM(0 To 1): TM(0) = "Diffusion du jour :": TM(1) = "— (aucune)"
   For L = 1 To UBound(TD)
      If TD(L, 5) = Date Then
         LM = LM + 1: ReDim Preserve TM(0 To LM)
         TM(LM) = "— " & TD(L, 1) & " " & TD(L, 2): End If: Next L
   If LM > 0 Then MsgBox Join(TM, vbLf), vbInformation, Me.Name
   End Sub

sousou · 24 Mars 2023

Bonjour
Un début vite fait

JHA · 24 Mars 2023

Bonjour à tous,

Tu peux le faire par formule.

JHA

Dranreb · 24 Mars 2023

Bonjour.
Aussi possible dans ThisWorkbook :

VB:

Option Explicit
Private Sub Workbook_Open()
   Dim TD(), L As Long, TM() As String, LM As Long
   TD = Feuil1.ListObjects(1).DataBodyRange.Value
   ReDim TM(0 To 1): TM(0) = "Diffusion du jour :": TM(1) = "— (aucune)"
   For L = 1 To UBound(TD)
      If TD(L, 5) = Date Then
         LM = LM + 1: ReDim Preserve TM(0 To LM)
         TM(LM) = "— " & TD(L, 1) & " " & TD(L, 2): End If: Next L
   MsgBox Join(TM, vbLf), vbInformation, Me.Name
   End Sub

chnico80 · 24 Mars 2023

Dranreb à dit:

Bonjour.
Aussi possible dans ThisWorkbook :

VB:

Option Explicit
Private Sub Workbook_Open()
   Dim TD(), L As Long, TM() As String, LM As Long
   TD = Feuil1.ListObjects(1).DataBodyRange.Value
   ReDim TM(0 To 1): TM(0) = "Diffusion du jour :": TM(1) = "— (aucune)"
   For L = 1 To UBound(TD)
      If TD(L, 5) = Date Then
         LM = LM + 1: ReDim Preserve TM(0 To LM)
         TM(LM) = "— " & TD(L, 1) & " " & TD(L, 2): End If: Next L
   MsgBox Join(TM, vbLf), vbInformation, Me.Name
   End Sub

Merci à tous pour vos retour, les 2 solutions sont intéressantes. Merci beaucoup.

@Dranreb , ton code me donne un message d'erreur

Dranreb · 24 Mars 2023

Peut être plage non mise sous forme de tableau de sorte que la colllection ListObjects est vide.

chnico80 · 24 Mars 2023

Dranreb à dit:
Peut être plage non mise sous forme de tableau de sorte que la colllection ListObjects est vide.

lol j'avoue que je n'ai pas compris

Dranreb · 24 Mars 2023

Sélectionnez la plage, menu Accueil, groupe Style, commande Mettre sous forme de tableau.

chnico80 · 24 Mars 2023

Dranreb à dit:
Sélectionnez la plage, menu Accueil, groupe Style, commande Mettre sous forme de tableau.

Ah franchement c'est nickel, merci beaucoup

chnico80 · 24 Mars 2023

Juste une dernière question, est ce possible de n'avoir la boite de dialogue QUE lorsqu'il y a une ou plusieurs diffusion à faire ??

Dranreb · 24 Mars 2023

Oui, bien sûr, il suffit de mettre If LM > 0 Then devant MsgBox

chnico80 · 24 Mars 2023

Dranreb à dit:
Oui, bien sûr, il suffit de mettre If LM > 0 Then devant MsgBox

Je pense que j'ai mal fait car j'ai un message d'erreur

Dranreb · 24 Mars 2023

Si vous l'avez mis dans une instruction supplémentaire devant la MsgBox, il faut terminer par une End If.

chnico80 · 24 Mars 2023

Dranreb à dit:
Si vous l'avez mis dans une instruction supplémentaire devant la MsgBox, il faut terminer par une End If.

je suis désolé je n'y arrive pas

Dranreb · 24 Mars 2023

VB:

Option Explicit
Private Sub Workbook_Open()
   Dim TD(), L As Long, TM() As String, LM As Long
   TD = Feuil1.ListObjects(1).DataBodyRange.Value
   ReDim TM(0 To 1): TM(0) = "Diffusion du jour :": TM(1) = "— (aucune)"
   For L = 1 To UBound(TD)
      If TD(L, 5) = Date Then
         LM = LM + 1: ReDim Preserve TM(0 To LM)
         TM(LM) = "— " & TD(L, 1) & " " & TD(L, 2): End If: Next L
   If LM > 0 Then MsgBox Join(TM, vbLf), vbInformation, Me.Name
   End Sub

Microsoft 365 Boite de dialogue suivant date et récupération de données

chnico80

XLDnaute Nouveau

Pièces jointes

Dranreb

sousou

XLDnaute Barbatruc

Pièces jointes

JHA

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

chnico80

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

chnico80

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

chnico80

XLDnaute Nouveau

chnico80

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

chnico80

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

chnico80

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Discussions similaires