Code erreur 91 variable objet ou variable de bloc with non définie

Le 08/12/2023 à 08:19

Bonjour à tous

J'ai ce message d'erreur lorsque je veux insérer une image

code erreur 91 variable objet ou variable de bloc with non définie

Pouvez-vous m'aider?

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

Edit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention la prochaine fois

Le 08/12/2023 à 10:05

Bonjour,

SI vous respectiez l'indentation dans votre code, vous verriez qu'il manque des lignes (ci-dessous au niveau des **********************)

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

Cdlt

Le 08/12/2023 à 10:17

Bonjour GregExcel, Arturo83 , le forum,

J'ai testé le code, je n'ai aucune erreur.....(excel 2010).....

@Arturo83: j'étais parti sur la même hypothèse, mais en indentant le code, je n'ai décelé aucune erreur...?

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

Cordialement,

Le 08/12/2023 à 10:52

Bonjour

Effectivement j'avais oublié de cocher la case "Modifier les objets" lors de la protection de la feuille

Merci d'avoir pris le temps de regarder

Bonne journée

Rechercher des sujets similaires à "code erreur variable objet bloc definie"