probleme de cellules fusionnées

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [COLOR="Red"]ActiveCell[/COLOR].Column = 7 And [COLOR="red"]ActiveCell [/COLOR]<> "" Then
  répertoireImage = ThisWorkbook.Path   ' à adapter
  NomImage = [COLOR="red"]ActiveCell[/COLOR]
  If Dir(répertoireImage & "\" & NomImage & ".jpg") <> "" Then
    With UserForm1
      .StartUpPosition = 1
      taille = TaillePixelsImage(répertoireImage, NomImage & ".jpg")
      rap = Val(Split(taille, "x")(0)) / Val(Split(taille, "x")(1))
      .Image1.Height = 200             ' on fixe la hauteur
      .Image1.Width = .Image1.Height * rap
      .Height = .Image1.Height + 20
      .Width = .Image1.Width
      .Image1.Picture = LoadPicture(répertoireImage & "\" & NomImage & ".jpg")
      .Show
    End With
  End If
End If
End Sub