Image changeante en fonction d'une date ou d'une période de l'année

Bonjour à tous,

J’espère que vous allez bien,

J’aurai encore besoin de votre aide s’il vous plait : est-il possible, en VBA, d’afficher une image en fonction d’une « date » précise ou une période de l’année ?

En effet, j’ai un fichier (voir pièce jointe) qui a 2 feuilles : l’une nommé « Image » contient des images de certaines périodes de l’année telle que « Noel » et le « Nouvel An ».

Et dans l’autre feuille nommé « Index » :

• J’aimerai que du 24 au 25 Décembre de chaque année, s’affiche l'image de Noël.
• Et du 31 Décembre au 01 Janvier, affiche l'image du Nouvel AN …

Malgré mes recherches, je n'arrive pas à trouver la solution
Pourriez-vous me donner une piste s’il vous plait ?
Dans l’attente

Personne pour m'aider svp ?

Bonsoir,

Vous n'avez pas l'impression d'abuser là... en faisant un up 1h30 après votre demande un week-end de 1er novembre

Nous sommes tous bénévoles ici, il n'y a donc aucune URGENCE comme indiqué dans la charte de ce forum !!!

Bonne nuit

Désolé M. JExcel2fr,

Bonne fête de toussaint à tous,

Dans l'attente de votre retour,

Cordialement

Bonjour à tous,

Mets ce code dans le module ThisWorkbook :

Private Sub Workbook_Open()
  For i = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(i).Delete
  Next i
  If (Day(Date) = 24 Or Day(Date) = 25) And Month(Date) = 12 Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 1")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With

  ElseIf (Day(Date) = 31 And Month(Date) = 12) Or (Day(Date) = 1 And Month(Date) = 1) Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 1")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With
  End If
End Sub

Daniel

Bonjour DanielC, bonjour à tous.

Je viens de tester votre code : quand je change la date de mon PC au 25 décembre 2024, 'image de Noel s'affiche. Donc c'est OK.

Mais lorsque je change à nouveau la date de mon PC au 31 décembre 2024 :

1) L'image de Noel disparait de la feuille "Image", or j'aimerai que les images soient conservées et non supprimées,

2) La seconde image (feu d'artifice au port de Sydney) n'apparait pas et j'ai le message d'erreur ci-dessous.

Par conséquent, dans votre code, je ne comprend pas comment la macro sait que c'est "Picture 1 ou "Picture 2 ou "Picture X qui doit être affiché dans la feuille "Index".

Pouvez-vous mieux m'expliquer votre code ?

Dans l'attente de votre retour s'il vous plait. (fichier joint en dessous)

J'ai rectifié pour l'effacement des images. Par contre je n'ai pas d'erreur quand je mets la date au 31/12. Est-ce qu'il y a une ligne de code surlignée en jaune ? Ci-joint le code de test modifié. Pour éviter de changer la date de l'ordi, la macro ne teste pas la date ordi, mais la valeur de la variable "Dat" :

Quand la macro sera finalisée, je remettrai le test sur la date système. Mets la macro dans un module standard :

Sub test()
  Dim Dat As Date
  Dat = #12/31/2024#
  For i = 1 To Sheets("Index").Shapes.Count
    Sheets("Index").Shapes(i).Delete
  Next i
  If (Day(Dat) = 24 Or Day(Dat) = 25) And Month(Dat) = 12 Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 1")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With

  ElseIf (Day(Dat) = 31 And Month(Dat) = 12) Or (Day(Dat) = 1 And Month(Dat) = 1) Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 2")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With
  End If
End Sub

PS. "Picture 1" est le nom de l'image de Noël. "Picture 2" celui du 1er janvier. Je mettrai des explications complètes dans le code quand celui-ci sera finalisé.

Merci DanielC,

Dans l'attente des explications complètes du code et merci encore.

DanielC, j'ai finalement compris et améliorer ton code.

Voici le rendu que je voulais :

'  Dim Dat As Date
'  Dat = #12/31/2024#
  For i = 1 To Sheets("Index").Shapes.Count
    Sheets("Index").Shapes(i).Delete
  Next i

'  If (Day(Date) = 1 Or Day(Date) = 2) And Month(Date) = 11 Then
  If (Day(Date) = 24 Or Day(Date) = 25) And Month(Date) = 12 Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 1")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With

  ElseIf (Day(Date) = 31 And Month(Date) = 12) Or (Day(Date) = 1 And Month(Date) = 1) Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 2")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With

  ElseIf (Day(Date) >= 1 And Day(Date) <= 31) And Month(Date) = 11 Then
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 3")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With
  End If

Merci encore, merci à tous.

Je ne vois pas en quoi le code est "amélioré". Tu l'as modifié pour 1) insérer une troisième image, 2) modifier les dates d'affichage, c'est tout. Ces deux points n'étaient pas dans ta demande initiale.

Daniel

Oui oui, tu a raison.

J'attends alors tes explications sur le code stp.

Dans l'attente

Sub test()
  Dim Dat As Date
  Dat = #12/31/2024#
  'Suppresion des images de la feuille Index
  For i = 1 To Sheets("Index").Shapes.Count
    Sheets("Index").Shapes(i).Delete
  Next i
  'Test image de Noël
  If (Day(Dat) = 24 Or Day(Dat) = 25) And Month(Dat) = 12 Then
    'tout ce qui commence par un "." se rapporte à la feuille "Index""
    With Sheets("Index")
      'Sélection de la feuille Image
      Sheets("Image").Select
      'sélection de l'image
      Sheets("Image").Shapes.Range(Array("Picture 1")).Select
      'copie de l'image
      Selection.Copy
      'sélection de la feuille Index
      .Select
      'sélection de la cellule de destination
      .Range("C5").Select
      'collage de l'image
      .Paste
      .[A1].Select
    End With

  ElseIf (Day(Dat) = 31 And Month(Dat) = 12) Or (Day(Dat) = 1 And Month(Dat) = 1) Then
    'même chose que pour Noël
    With Sheets("Index")
      Sheets("Image").Select
      Sheets("Image").Shapes.Range(Array("Picture 2")).Select
      Selection.Copy
      .Select
      .Range("C5").Select
      .Paste
      .[A1].Select
    End With
  End If
End Sub

Daniel

Merci beaucoup