Bonjour,

C'est mon premier post et j'espère que je vais trouver une âme charitable pour m'aider

Voilà le problème : Je souhaite exécuter deux macros dans un module. La première affiche une image du répertoire mariage dans une cellule. La deuxième affiche également une image mais du répertoire anniversaire dans une autre cellule.

Le code de la première macro fonctionne nickel mais je n'arrive pas à exécuter la deuxième. Mes photos de mariage s'affichent mais pas les anniversaires

Je pense qu'il faut que j'utilise la fonction call mais je suis perdue.

Mon code est le suivant :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$L$6" And Target.Count = 1 Then
    On Error Resume Next
    Shapes("MonImage").Delete
    répertoirePhoto = "L:\2012\1_Photos_Mariage"    ' adapter
    nf = répertoirePhoto & "\" & Target & ".jpg"
    If Dir(nf) <> "" Then
      Set c = Range("G6").MergeArea
      Set img = ActiveSheet.Pictures.Insert(nf)
      img.Name = "MonImage"
      img.Left = [G6].Left
      img.Top = [G6].Top
      Shapes("monimage").Height = c.Height ' On impose la hauteur
      Shapes("monimage").Width = c.Width   ' On impose la largeur
     End If
  End If
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change1(ByVal Target As Range)
  If Target.Address = "$L$16" And Target.Count = 1 Then
    On Error Resume Next
    Shapes("MonImage").Delete
    répertoirePhoto = "L:\2012\1_Photos_Anniversaire"    ' adapter
    nf = répertoirePhoto & "\" & Target & ".jpg"
    If Dir(nf) <> "" Then
      Set c = Range("G16").MergeArea
      Set img = ActiveSheet.Pictures.Insert(nf)
      img.Name = "MonImage"
      img.Left = [G16].Left
      img.Top = [G16].Top
      Shapes("monimage").Width = c.Width   ' On impose la largeur
      Shapes("monimage").Height = c.Height ' On impose la hauteur
      Shapes("monimage").LockAspectRatio = msoFalse
     End If
  End If
End Sub
Par avance je vous remercie !