Recherche d'image dans une cellule

[Maathis]

Bonjour à tous.

Je travaille actuellement sur un formulaire de saisie de données avec une base de données.

Et je bloque sur mon formulaire de saisie de données...
En effet les utilisateurs devront insérer une image mais j'aimerais qu'il ne puisse pas enregistrer leur données tant qu'il n'y a pas d'image.

Serait-il possible de rechercher si une image est présente ou non dans la cellule spécifié avec un bloc if.

Merci d'avance pour vos conseils
Mathis

 

[Dudu2]

Bonjour,
Je ferais ça, si l'image est cadrée sur le coin haut gauche de la cellule.

Sub Test()
    MsgBox ImageEstenCellule([F6])
End Sub

Function ImageEstenCellule(Cellule As Range)
    Dim Sh As Shape
  
    For Each Sh In Cellule.Parent.Shapes
        If Sh.Type = msoPicture And Sh.Top = Cellule.Top And Sh.Left = Cellule.Left Then Exit For
    Next Sh
  
    If Not Sh Is Nothing Then ImageEstenCellule = True
End Function

 

[Maathis]

Merci de l'aide.

Mais est on obligé de passer par une fonction pour arrivé au résultat voulu ?

Merci

 

[Maathis]

Je vous met mon code pour importer l'image, j'ai essayer de centrer l'image dans la cellule.

Sub import_image()

Application.ScreenUpdating = False

Dim Image As Variant

Dim L As Single, T As Single, W As Single, H As Single

On Error Resume Next

    L = Range("K26").Left + 5
    T = Range("K26").Top + 5
    W = Range("K26").Width - 13
    H = Range("K26").Height - 13
  
    Image = Application.GetOpenFilename
    ActiveSheet.Shapes.AddPicture Image, True, True, L, T, W, H
    
On Error GoTo 0

Application.ScreenUpdating = True

End Sub

 

[Maathis]

J'ai trouvé ma réponse sur un site : https://www.excelhow.net/check-if-a-cell-contain-imagepicture.html

Tout marche mais ne comprend juste pas la variable "x"

Merci de votre aide

Sub test_image()

    Dim checkRange As Range
    Dim x As Shape
    Dim pic As Boolean
   
    On Error Resume Next
    Set checkRange = Range("K26")

        For Each x In ActiveSheet.Shapes
            If x.TopLeftCell.Address = checkRange.Address Then
                pic = True
            End If
        Next
       
    If pic Then
   
        MsgBox "Yes"
       
        'Suite du programme
    Else
        MsgBox "Pas d'image inséré"
    End If
   
End Sub