[RESOLU]_Insérer une image dans une zone en la mettant à l'échelle (Améliorer code)

[Gdal]

Bonjour,

J'ai "réalisé" un bout de code qui me permet d'insérer une image dans une zone avec une mise à l'échelle.
Mais je ne suis pas content de la fin....

    ' Image plus large que haute et plus large que la zone
    If iLgImg > iHtImg And iLgImg > iLgZone Then

        ' Ajuster par rapport à la largeur
        g.Width = g.Width * (iLgZone / g.Width)
    
    ' Image plus haute que large et plus haute que la zone
    ElseIf iHtImg > iLgImg And iHtImg > iHtZone Then

        ' Ajuster par rapport à la hauteur
         g.Height = g.Height * (iHtZone / g.Height)
   
    End If
    
    
    If g.Width > iLgZone Then
    
        g.Width = g.Width * (iLgZone / g.Width)
    
    ElseIf g.Height > iHtZone Then
    
        g.Height = g.Height * (iHtZone / g.Height)
    
    End If

Je n'arrive pas à combiner les if...
Regarde la pièce jointe Mise à l'échelle.zip

Ma prochaine étape sera de centrer l'image dans la zone... Je posterais le code.

Merci

Gdal

 

[Gdal]

Re : Insérer une image dans une zone en la mettant à l'échelle (Améliorer code)

Bonjour,

Voici le code complet:

'---------------------------------------------------------------------------------------
' Procédure   : fctInsererIMG
' Auteur      : A.G.
' Date        : 19/02/2012
' Description : Insérer une image dans une zone avec mise à l'échelle et alignement
'---------------------------------------------------------------------------------------
'
Sub fctInsererIMG(sChemin As String, sNomImage As String, sNomZone As String, eTypeAlignement As eLstAlignement)

    '> Supprimer l'ancienne image
    '----------------------------
    ' Parcourir les formes à la recherche de l'image et la supprimer
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.Name = sNomImage Then ActiveSheet.Shapes(sNomImage).Delete
    Next ShapeObj
    
    '> Insérer la nouvelle image
    '---------------------------
    Dim vZonePosL As Variant
    Dim vZonePosT As Variant
    Dim vZoneTailW As Variant
    Dim vZoneTailH As Variant
    
    ' Position / Taille de la zone
    vZonePosL = Range(sNomZone).Left
    vZonePosT = Range(sNomZone).Top
    vZoneTailW = Range(sNomZone).Width
    vZoneTailH = Range(sNomZone).Height
    
    ' Insérer l'image
    Dim oImage As Shape
    Set oImage = ActiveSheet.Shapes.AddPicture(sChemin, True, True, vZonePosL, vZonePosT, vZoneTailW, vZoneTailH)
    
    '> Dimensionner l'image
    '----------------------
    ' Nommer l'image
    oImage.Name = sNomImage
    
    ' Mettre à l'échelle 1 l'image
    oImage.ScaleWidth 1, msoTrue
    oImage.ScaleHeight 1, msoTrue

    ' Conserver les proportions
    oImage.LockAspectRatio = msoTrue

    ' Dimensions de l'image
    Dim vImgTailW As Variant
    Dim vImgTailH As Variant
    vImgTailW = oImage.Width
    vImgTailH = oImage.Height

    ' Image plus large ou plus haute que la zone
    If vImgTailW > vZoneTailW Or vImgTailH > vZoneTailH Then

        ' Image plus large que la zone
        If vImgTailW > vZoneTailW Then

            ' Ajuster par rapport à la largeur
            oImage.Width = vImgTailW * (vZoneTailW / vImgTailW)

        End If

        ' Nouvelle taille de l'image
        vImgTailW = oImage.Width
        vImgTailH = oImage.Height
        
        ' Image plus haute que la zone
        If vImgTailH > vZoneTailH Then

            ' Ajuster par rapport à la hauteur
            oImage.Height = vImgTailH * (vZoneTailH / vImgTailH)

        End If

    End If
    
    '> Alignement de l'image
    '-----------------------
    Dim vImgPosL As Variant
    Dim vImgPosT As Variant
    
    ' Nouvelle taille de l'image
    vImgTailW = oImage.Width
    vImgTailH = oImage.Height
    
    ' Alignement Horizontal
    Select Case eTypeAlignement
    '   Aligner à Gauche
    Case eLstAlignement.BasGauche, eLstAlignement.MilieuGauche, eLstAlignement.HautGauche
        vImgPosL = vZonePosL
        
    '   Aligner au Centre
    Case eLstAlignement.BasCentre, eLstAlignement.MilieuCentre, eLstAlignement.HautCentre
        vImgPosL = vZonePosL + ((vZoneTailW / 2) - (vImgTailW / 2))
        
    '   Aligner à Droite
    Case eLstAlignement.BasDroite, eLstAlignement.MilieuDroite, eLstAlignement.HautDroite
        vImgPosL = vZonePosL + (vZoneTailW - vImgTailW)
        
    End Select
    
    ' Alignement Vertical
    Select Case eTypeAlignement
    '   Aligner en Haut
    Case eLstAlignement.HautDroite, eLstAlignement.HautGauche, eLstAlignement.HautCentre
        vImgPosT = vZonePosT
    
    '   Aligner au Milieu
    Case eLstAlignement.MilieuDroite, eLstAlignement.MilieuGauche, eLstAlignement.MilieuCentre
        vImgPosT = vZonePosT + ((vZoneTailH / 2) - (vImgTailH / 2))

    '   Aligner en Bas
    Case eLstAlignement.BasDroite, eLstAlignement.BasGauche, eLstAlignement.BasCentre
        vImgPosT = vZonePosT + (vZoneTailH - vImgTailH)
        
    End Select
    
    ' Positionner l'image
    oImage.Top = vImgPosT
    oImage.Left = vImgPosL
    
End Sub

Le fichier: Regarde la pièce jointe Mise à l'échelle _ v2.zip

Gdal