Message "Erreur de compilation Sub End attendu"

Bonsoir à tous et a toutes j'ai trouvé sur le site cette procédure qui me convient (insertion image à la taille d'une cellule):

    Sub insere_image_ratio()
    Dim ficimg As String, Ad As String
    Dim MemW As Long, MemH As Long, T As Integer, L As Integer
    Dim Lg As Integer, HT As Integer, RatioCell As Single
    Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
        Ad = Selection.Address
        CellH = Selection.Height
        CellW = Selection.Width
        ficimg = Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
       If ficimg = "Faux" Then Exit Sub
        ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
       With Selection.ShapeRange
            MemW = .Width: MemH = .Height
            'adapte les ratio
           If MemH < CellH And MemW < CellW Then
            'l'image < cellule
               RatioHz = MemH / CellH
                RatioVt = MemW / CellW
                If RatioVt < RatioHz Then 'adapter en hauteur
                   HT = CellH:  Lg = MemW * (HT / MemH)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                   Lg = CellW: HT = MemH * (CellW / MemW)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf MemH > CellH And MemW > CellW Then
            'l'image > cellule
               RatioHz = CellH / MemH
                RatioVt = CellW / MemW
                If RatioVt > RatioHz Then 'adapter en hauteur
                   HT = CellH:  Lg = MemW * (HT / MemH)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                   Lg = CellW: HT = MemH * (Lg / MemW)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf MemH > CellH And MemW < CellW Then
            'adapter en hauteur
               HT = CellH:  Lg = MemW * (HT / MemH)
                T = 0: L = (CellW - Lg) / 2
            ElseIf MemH < CellH And MemW > CellW Then
            'adapter en largeur
               Lg = CellW: HT = MemH * (Lg / MemW)
                L = 0: T = (CellH - HT) / 2
            Else
                Stop ' pas prévu ?
           End If

            .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
           .Top = Range(Ad).Top + T ' haut de la cellule
           .Left = Range(Ad).Left + L ' gauche de la cellule
           .Height = HT
            .Width = Lg ' largeur des cellules fusionnées
       End With
        With Selection
            .Placement = xlMoveAndSize
            .PrintObject = True
        End With
    End Sub
     

Je désir l'exécuter en double cliquant sur la cellule C10 j'ai trouvé également ceci sur le site (Lancer une macro par clic sur une cellule):

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("A1")) Is Nothing Then

'macro à mettre

End If

J'ai placé la macro du haut dans celle du bas à la place marqué 'macro à mettre et changer A1 par C10 mais à l'execution de l'ensemble j'ai le message d'erreur suivant : "Erreur de compilation Sub End attendu" étant novice merci de bien m'aider

Cordialement

Bonjour,

Il faut un end sub à la fin de la macro évènementielle et pour appeler la macro, il faut mettre l'instruction call NomDeLaMacro.

Voici un essai d'adaptation du code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
cancel = true
If Not Intersect(Target, Range("A1")) Is Nothing Then
    call InsereImage(range("A1"))
End If
End sub

Sub InsereImage(Cible as range)
Dim ficimg As String
ficimg = Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
With activesheet.shapes.addpicture(ficimg, msofalse, msotrue, Cible.left, Cible.top, -1, -1)
    .Height = .Parent.Rows(Cible.row).RowHeight
end with
End Sub     

Avec votre macro simplifiée (sans certitude qu'elle produise vraiment l'effet escompté) et la macro évènementielle qui l'exécute. Donc on double-clique en A1 et l'image sélectionnée doit s'y insérer.

Cdlt,

Bonjour et merci cela à résolut mes problèmes bonne journée à vous

Cordialement

Bonjour,

Super, bonne journée à vous aussi !